This patch contain a few fixes needed to make SCIX v0.97 compile with the
new Scheme->C compiler (28sep90) from DECWRL. It is mostly trivial removal
of unnecessary eval-when clauses. Apply by doing "patch -p1 < this-file"
when standing in the SCIX root directory.
This is only a patch to make SCIX compile correctly. No new stuff is
included. You'll have to wait for that.
Johan Ihren <johani@nada.kth.se>
diff -c -r scix-0.97/macros/defclass.sc scix-0.97-fix/macros/defclass.sc
*** scix-0.97/macros/defclass.sc Fri Jul 6 00:41:24 1990
--- scix-0.97-fix/macros/defclass.sc Thu Nov 8 23:43:14 1990
***************
*** 99,105 ****
;; Object oriented system
- (eval-when (compile load eval)
(extend-syntax (define-class locals inherit methods init)
;; All parts - #1
((define-class (name . idlist)
--- 99,104 ----
***************
*** 407,411 ****
;; (methods)
;; (init)))
)
-
- ) ;; End of eval-when
--- 406,408 ----
diff -c -r scix-0.97/macros/defhclass.sc scix-0.97-fix/macros/defhclass.sc
*** scix-0.97/macros/defhclass.sc Fri Jul 6 00:41:52 1990
--- scix-0.97-fix/macros/defhclass.sc Thu Nov 8 23:43:15 1990
***************
*** 97,111 ****
;; Convenience macro
! (eval-when (compile load eval)
(extend-syntax (insert-method!)
((insert-method! object message func)
(object 'insert-method! message
! (let ((me object)) func)))) )
;; Object oriented system
! (eval-when (compile load eval)
(extend-syntax (define-class locals inherit methods init)
;; All parts - #1
((define-class (name . idlist)
--- 97,111 ----
;; Convenience macro
!
(extend-syntax (insert-method!)
((insert-method! object message func)
(object 'insert-method! message
! (let ((me object)) func))))
;; Object oriented system
!
(extend-syntax (define-class locals inherit methods init)
;; All parts - #1
((define-class (name . idlist)
***************
*** 523,527 ****
;; (methods)
;; (init)))
)
-
- ) ;; End of eval-when
--- 523,525 ----
diff -c -r scix-0.97/macros/deflclass.sc scix-0.97-fix/macros/deflclass.sc
*** scix-0.97/macros/deflclass.sc Fri Jul 6 00:42:00 1990
--- scix-0.97-fix/macros/deflclass.sc Thu Nov 8 23:43:15 1990
***************
*** 40,46 ****
;;; system.
;;; Inheritance is not supported for light-weight objects.
;;;
! (eval-when (compile eval load)
(extend-syntax (define-lw-class locals methods init)
((define-lw-class (name . idlist)
(locals (loc-var loc-val) ...)
--- 40,46 ----
;;; system.
;;; Inheritance is not supported for light-weight objects.
;;;
!
(extend-syntax (define-lw-class locals methods init)
((define-lw-class (name . idlist)
(locals (loc-var loc-val) ...)
***************
*** 121,125 ****
(init) ))
)
-
- ) ;; End of eval-when
--- 121,123 ----
diff -c -r scix-0.97/macros/extsyntax.sc scix-0.97-fix/macros/extsyntax.sc
*** scix-0.97/macros/extsyntax.sc Thu Mar 8 22:46:41 1990
--- scix-0.97-fix/macros/extsyntax.sc Thu Nov 8 23:43:16 1990
***************
*** 281,287 ****
;;; End of eval-when (compile eval)
)
- (eval-when (compile load eval)
(define-macro extend-syntax
(let ((x (gensym "X")))
(lambda (form expander)
--- 281,286 ----
***************
*** 329,333 ****
'proc))))
(else (error 'extend-syntax/code "invalid syntax: ~a" form)))
expander ))))
-
- ) ;;; End of eval-when
--- 328,330 ----
diff -c -r scix-0.97/macros/mask-obj.sc scix-0.97-fix/macros/mask-obj.sc
*** scix-0.97/macros/mask-obj.sc Tue Jun 19 17:55:13 1990
--- scix-0.97-fix/macros/mask-obj.sc Thu Nov 8 23:43:16 1990
***************
*** 50,57 ****
;;; is to keep the symbolic names as far as possible, we have
;;; chosen this implementation.
- (eval-when (load compile eval)
-
(extend-syntax (make-mask)
((make-mask ((id type) ...))
(with (((ids ...) (remq 'unused '(id ...))))
--- 50,55 ----
***************
*** 188,191 ****
;;; but the code would never be executed, so it doesn't cause any trouble
;;; when used interactively. Alas, the compiler doesn't understand this fact...
((make-mask (id ...))
! (make-mask ((id '()) ...)) )) )
--- 186,189 ----
;;; but the code would never be executed, so it doesn't cause any trouble
;;; when used interactively. Alas, the compiler doesn't understand this fact...
((make-mask (id ...))
! (make-mask ((id '()) ...)) ))
diff -c -r scix-0.97/src/bitmasks.sc scix-0.97-fix/src/bitmasks.sc
*** scix-0.97/src/bitmasks.sc Tue Jun 26 09:46:48 1990
--- scix-0.97-fix/src/bitmasks.sc Thu Nov 8 23:43:16 1990
***************
*** 77,84 ****
the-mask))
(define (make-pointerevent-mask . initial-settings)
! (let ((the-mask (make-mask (unused
! unused
ButtonPress
ButtonRelease
EnterWindow
--- 77,84 ----
the-mask))
(define (make-pointerevent-mask . initial-settings)
! (let ((the-mask (make-mask (unused-1
! unused-2
ButtonPress
ButtonRelease
EnterWindow
***************
*** 102,111 ****
KeyRelease
ButtonPress
ButtonRelease
! unused
! unused
PointerMotion
! unused
Button1Motion
Button2Motion
Button3Motion
--- 102,111 ----
KeyRelease
ButtonPress
ButtonRelease
! unused-1
! unused-2
PointerMotion
! unused-3
Button1Motion
Button2Motion
Button3Motion
diff -c -r scix-0.97/src/cmap-obj.sc scix-0.97-fix/src/cmap-obj.sc
*** scix-0.97/src/cmap-obj.sc Fri Jul 6 00:28:40 1990
--- scix-0.97-fix/src/cmap-obj.sc Thu Nov 8 23:43:17 1990
***************
*** 46,52 ****
(define-external x-reply? scixmu)
! (eval-when (compile eval load)
(define-class (colormap scr &optional id)
(locals
(write-enabled '()) ; List of write-enabled pixels
--- 46,52 ----
(define-external x-reply? scixmu)
!
(define-class (colormap scr &optional id)
(locals
(write-enabled '()) ; List of write-enabled pixels
***************
*** 233,236 ****
(number? (car id)) ) ; i e id given by server
(me 'scix-announce-id! me) ))
)
- ) ;; End of eval-when
--- 233,235 ----
diff -c -r scix-0.97/src/font-obj.sc scix-0.97-fix/src/font-obj.sc
*** scix-0.97/src/font-obj.sc Mon May 7 11:34:58 1990
--- scix-0.97-fix/src/font-obj.sc Thu Nov 8 23:43:17 1990
***************
*** 34,40 ****
;;; The SCIX Font Object.
- (eval-when (compile eval load)
(define-class (font fontname scr &optional id)
(inherit (resource scr (if (null? id)
#f
--- 34,39 ----
***************
*** 60,63 ****
(number? (car id)) ) ; i e id given by server
(me 'scix-announce-id! me) ))
)
- ) ;; End of eval-when
--- 59,61 ----
diff -c -r scix-0.97/src/newtypes.tmpl scix-0.97-fix/src/newtypes.tmpl
*** scix-0.97/src/newtypes.tmpl Tue Jun 26 09:53:38 1990
--- scix-0.97-fix/src/newtypes.tmpl Fri Nov 9 00:02:15 1990
***************
*** 3,17 ****
;;; syntax (define-enum-type type name alist)
;;; a-name and d-name are automaticly defined
! (eval-when (eval compile load)
- (define (turn alist) ; reverses the pairs in alist - Obs alist must be quoted
- (let loop ((alist (cadr alist)) (res '()))
- (if (null? alist)
- res
- (let ((el (car alist)))
- (loop (cdr alist) (append res (list (cons (cdr el) (car el)))))))))
-
(extend-syntax (define-enum-type)
((define-enum-type type name alist)
(with ((dlist (turn 'alist))
--- 3,18 ----
;;; syntax (define-enum-type type name alist)
;;; a-name and d-name are automaticly defined
! ;;; turn -- reverses the pairs in alist - Obs alist must be quoted
! (eval-when (eval compile)
! (define (turn alist)
! (let loop ((alist (cadr alist)) (res '()))
! (if (null? alist)
! res
! (let ((el (car alist)))
! (loop (cdr alist) (append res (list (cons (cdr el) (car el)))))))))
! )
(extend-syntax (define-enum-type)
((define-enum-type type name alist)
(with ((dlist (turn 'alist))
***************
*** 32,39 ****
(define d-name (lambda (str dpy)
((d-const #t d-type 'dlist) str dpy)))
))))
-
- ) ; end of eval-when
(define-enum-type CARD8 bitgravity '((Forget . 0)
(NorthWest . 1)
--- 33,38 ----
diff -c -r scix-0.97/src/objects.sc scix-0.97-fix/src/objects.sc
*** scix-0.97/src/objects.sc Fri Jul 6 00:27:10 1990
--- scix-0.97-fix/src/objects.sc Thu Nov 8 23:43:18 1990
***************
*** 61,67 ****
((scr 'scix-id-vector) 'insert-with-key! me id) ))
;;; Drawables -- windows and pixmaps.
! (eval-when (compile eval load)
(define-class (drawable width height depth scr id)
(locals
(callbacks '()) )
--- 61,67 ----
((scr 'scix-id-vector) 'insert-with-key! me id) ))
;;; Drawables -- windows and pixmaps.
!
(define-class (drawable width height depth scr id)
(locals
(callbacks '()) )
***************
*** 168,177 ****
(if (x-reply? reply)
(list (reply 'width) (reply 'height))
reply))))
! )))
;;; Pixmaps.
! (eval-when (compile eval load)
(define-class (pixmap width height depth scr &optional id)
(locals
(drawable (scr 'root)) )
--- 168,177 ----
(if (x-reply? reply)
(list (reply 'width) (reply 'height))
reply))))
! ))
;;; Pixmaps.
!
(define-class (pixmap width height depth scr &optional id)
(locals
(drawable (scr 'root)) )
***************
*** 189,195 ****
(init
(if (or (null? id)
(not (number? (car id))) )
! (me 'scix-announce-id! me) ))))
;;; If a 'fill method is wanted for a pixmap it can be inserted like this:
;;; (pmap 'insert-method!
--- 189,195 ----
(init
(if (or (null? id)
(not (number? (car id))) )
! (me 'scix-announce-id! me) )))
;;; If a 'fill method is wanted for a pixmap it can be inserted like this:
;;; (pmap 'insert-method!
diff -c -r scix-0.97/src/view-obj.sc scix-0.97-fix/src/view-obj.sc
*** scix-0.97/src/view-obj.sc Mon May 7 11:36:22 1990
--- scix-0.97-fix/src/view-obj.sc Thu Nov 8 23:43:18 1990
***************
*** 46,52 ****
;;; (view 'set! <list of graphics>) -- set the display list
;;; (view 'contents) -- spew out the display list
;;;
! (eval-when (compile eval load)
(define-lw-class (view)
(locals
(display-list '()))
--- 46,52 ----
;;; (view 'set! <list of graphics>) -- set the display list
;;; (view 'contents) -- spew out the display list
;;;
!
(define-lw-class (view)
(locals
(display-list '()))
***************
*** 65,71 ****
(set! (lambda (obj-list) (set! display-list obj-list)))
))
- ) ;; End of eval-when
--- 65,70 ----
diff -c -r scix-0.97/src/win-obj.sc scix-0.97-fix/src/win-obj.sc
*** scix-0.97/src/win-obj.sc Fri Jul 6 00:21:49 1990
--- scix-0.97-fix/src/win-obj.sc Thu Nov 8 23:43:19 1990
***************
*** 47,53 ****
(include "../macros/extsyntax.sc")
(include "../macros/defclass.sc")
- (eval-when (compile eval load)
(define-class (window width height depth x y parent
border-width class visual scr &optional id)
(locals
--- 47,52 ----
***************
*** 214,217 ****
(parent 'scix-announce-child me) ))))
) ;; End of define-class
- ) ;; End of eval-when
--- 213,215 ----
diff -c -r scix-0.97/toolkit/buttons.sc scix-0.97-fix/toolkit/buttons.sc
*** scix-0.97/toolkit/buttons.sc Thu Jun 28 23:20:11 1990
--- scix-0.97-fix/toolkit/buttons.sc Thu Nov 8 23:43:19 1990
***************
*** 15,21 ****
;;; Generic button.
;;;
! (eval-when (compile load eval)
(define-class (button width height x y button-semantics
gc-draw gc-rev parent scr)
(locals
--- 15,21 ----
;;; Generic button.
;;;
!
(define-class (button width height x y button-semantics
gc-draw gc-rev parent scr)
(locals
***************
*** 105,115 ****
(me 'scix-announce-id! me)
(if parent ; i e this is not the root window
(parent 'scix-announce-child me) ))) ; all buttons are just "buttons"
- ) ;; End of eval-when
;;; Text-button (was push-button-text).
;;;
! (eval-when (compile load eval)
(define-class (text-button width height x y legend
gc-draw gc-rev gc-inv parent appl scr)
(locals
--- 105,114 ----
(me 'scix-announce-id! me)
(if parent ; i e this is not the root window
(parent 'scix-announce-child me) ))) ; all buttons are just "buttons"
;;; Text-button (was push-button-text).
;;;
!
(define-class (text-button width height x y legend
gc-draw gc-rev gc-inv parent appl scr)
(locals
***************
*** 147,157 ****
(if (eq? input 'ButtonRelease)
(appl)))))
gc-draw gc-rev parent scr) ))
- ) ;; End of eval-when
;;; Pixmap-button (was push-button-pixmap).
;;;
! (eval-when (compile load eval)
(define-class (pixmap-button width height x y pixmap
gc-draw gc-rev gc-inv parent appl scr)
(locals
--- 146,156 ----
(if (eq? input 'ButtonRelease)
(appl)))))
gc-draw gc-rev parent scr) ))
+
;;; Pixmap-button (was push-button-pixmap).
;;;
!
(define-class (pixmap-button width height x y pixmap
gc-draw gc-rev gc-inv parent appl scr)
(locals
***************
*** 175,185 ****
(if (eq? input 'ButtonRelease)
(appl)))))
gc-draw gc-rev parent scr) ))
- ) ;; End of eval-when
;;; Toggle-button.
;;;
! (eval-when (compile load eval)
(define-class (toggle-button width height x y gc-draw gc-rev gc-inv
parent appl-on appl-off scr)
(locals
--- 174,184 ----
(if (eq? input 'ButtonRelease)
(appl)))))
gc-draw gc-rev parent scr) ))
+
;;; Toggle-button.
;;;
!
(define-class (toggle-button width height x y gc-draw gc-rev gc-inv
parent appl-on appl-off scr)
(locals
***************
*** 210,213 ****
(me 'draw button-area gc-draw)
(scr 'flush!) )))
'R #f) ))
! ) ;; End of eval-when
--- 209,212 ----
(me 'draw button-area gc-draw)
(scr 'flush!) )))
'R #f) ))
!