Eliminate long-obsolete starbase support.

diff --git a/src/runtime/ed-ffi.scm b/src/runtime/ed-ffi.scm
index ad7e1ecb9520aeb5fc521bbda19b8713c0c7a248..81a2a3b50f4314c75953d897a7dd919799a31bee 100644 (file)
--- a/src/runtime/ed-ffi.scm
+++ b/src/runtime/ed-ffi.scm
@@ -148,7 +148,6 @@ USA.
     ("socket"  (runtime socket))
     ("srfi-1"  (runtime srfi-1))
     ("stack-sample" (runtime stack-sampler))
-    ("starbase"        (runtime starbase-graphics))
     ("stream"  (runtime stream))
     ("string"  (runtime string))
     ("stringio"        (runtime string-i/o-port))

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index a7f65ab1f18e63f90f24c892055e1f4e6d35c3cc..9b67f97eaab8af17ac7085afd7838152ebd5f9ca 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -552,7 +552,6 @@ USA.
    ;; Graphics.  The last type initialized is the default for
    ;; MAKE-GRAPHICS-DEVICE, only the types that are valid for the
    ;; operating system are actually loaded and initialized.
-   (OPTIONAL (RUNTIME STARBASE-GRAPHICS))
    (OPTIONAL (RUNTIME X-GRAPHICS))
    ;; Emacs -- last because it installs hooks everywhere which must be initted.
    (RUNTIME EMACS-INTERFACE)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index cb7b10add70df180d3069416b199d09e8a78f161..e2ae82dc7ab5a4fb5d7fc18b2c6ba554b3010438 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4315,7 +4315,6 @@ USA.
          x-graphics/set-mouse-color
          x-graphics/set-mouse-shape
          x-graphics/set-window-name
-         x-graphics/starbase-filename
          x-graphics/visual-info
          x-graphics/window-id
          x-graphics/withdraw-window
@@ -4347,15 +4346,6 @@ USA.
          x-visual-info/visual-id)
   (initialization (initialize-package!)))
 
-(define-package (runtime starbase-graphics)
-  (file-case os-type
-    ((unix) "starbase")
-    (else))
-  (parent (runtime))
-  (export ()
-         starbase-graphics-device-type)
-  (initialization (initialize-package!)))
-
 (define-package (runtime state-space)
   (files "wind")
   (parent (runtime))

diff --git a/src/runtime/starbase.scm b/src/runtime/starbase.scm
deleted file mode 100644 (file)
index 044c2fb..0000000
--- a/src/runtime/starbase.scm
+++ /dev/null
@@ -1,256 +0,0 @@
-#| -*-Scheme-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
-    2017 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-|#
-
-;;;; Starbase Graphics Interface
-;;; package: (runtime starbase-graphics)
-
-(declare (usual-integrations))
-\f
-(define-primitives
-  (starbase-open-device 2)
-  (starbase-close-device 1)
-  (starbase-flush 1)
-  (starbase-clear 1)
-  (starbase-move-cursor 3)
-  (starbase-drag-cursor 3)
-  (starbase-draw-line 5)
-  (starbase-draw-point 3)
-  (starbase-set-line-style 2)
-  (starbase-set-drawing-mode 2)
-  (starbase-device-coordinates 1)
-  (starbase-set-vdc-extent 5)
-  (starbase-reset-clip-rectangle 1)
-  (starbase-set-clip-rectangle 5)
-  (starbase-draw-text 4)
-  (starbase-set-text-height 2)
-  (starbase-set-text-aspect 2)
-  (starbase-set-text-slant 2)
-  (starbase-set-text-rotation 2)
-  (starbase-color-map-size 1)
-  (starbase-define-color 5)
-  (starbase-set-line-color 2)
-  (starbase-write-image-file 3))
-
-(define (initialize-package!)
-  (set! starbase-graphics-device-type
-       (make-graphics-device-type
-        'STARBASE
-        `((available? ,operation/available?)
-          (clear ,operation/clear)
-          (close ,operation/close)
-          (color-map-size ,operation/color-map-size)
-          (coordinate-limits ,operation/coordinate-limits)
-          (define-color ,operation/define-color)
-          (device-coordinate-limits ,operation/device-coordinate-limits)
-          (drag-cursor ,operation/drag-cursor)
-          (draw-line ,operation/draw-line)
-          (draw-point ,operation/draw-point)
-          (draw-text ,operation/draw-text)
-          (flush ,operation/flush)
-          (move-cursor ,operation/move-cursor)
-          (open ,operation/open)
-          (reset-clip-rectangle ,operation/reset-clip-rectangle)
-          (set-clip-rectangle ,operation/set-clip-rectangle)
-          (set-coordinate-limits ,operation/set-coordinate-limits)
-          (set-drawing-mode ,operation/set-drawing-mode)
-          (set-line-color ,operation/set-line-color)
-          (set-line-style ,operation/set-line-style)
-          (set-text-aspect ,operation/set-text-aspect)
-          (set-text-height ,operation/set-text-height)
-          (set-text-rotation ,operation/set-text-rotation)
-          (set-text-slant ,operation/set-text-slant)
-          (text-aspect ,operation/text-aspect)
-          (text-height ,operation/text-height)
-          (text-rotation ,operation/text-rotation)
-          (text-slant ,operation/text-slant)
-          (write-image-file ,operation/write-image-file))))
-  unspecific)
-
-(define starbase-graphics-device-type)
-\f
-(define-structure (starbase-graphics-descriptor
-                  (conc-name starbase-graphics-descriptor/)
-                  (constructor make-starbase-descriptor (identifier)))
-  (identifier #f read-only #t)
-  x-left
-  y-bottom
-  x-right
-  y-top
-  text-height
-  text-aspect
-  text-slant
-  text-rotation)
-
-(define (starbase-device/identifier device)
-  (starbase-graphics-descriptor/identifier
-   (graphics-device/descriptor device)))
-
-(define-syntax define-accessors-and-mutators
-  (sc-macro-transformer
-   (lambda (form environment)
-     (let ((name (cadr form)))
-       `(BEGIN
-         (DEFINE (,(symbol 'STARBASE-DEVICE/ name) DEVICE)
-           (,(close-syntax
-              (symbol 'STARBASE-GRAPHICS-DESCRIPTOR/ name)
-              environment)
-            (GRAPHICS-DEVICE/DESCRIPTOR DEVICE)))
-         (DEFINE
-           (,(symbol 'SET-STARBASE-DEVICE/ name '!) DEVICE VALUE)
-           (,(close-syntax
-              (symbol 'SET-STARBASE-GRAPHICS-DESCRIPTOR/ name '!)
-              environment)
-            (GRAPHICS-DEVICE/DESCRIPTOR DEVICE)
-            VALUE)))))))
-
-(define-accessors-and-mutators x-left)
-(define-accessors-and-mutators y-bottom)
-(define-accessors-and-mutators x-right)
-(define-accessors-and-mutators y-top)
-(define-accessors-and-mutators text-height)
-(define-accessors-and-mutators text-aspect)
-(define-accessors-and-mutators text-slant)
-(define-accessors-and-mutators text-rotation)
-\f
-(define (operation/available?)
-  (implemented-primitive-procedure? (ucode-primitive starbase-open-device 2)))
-
-(define (operation/open descriptor->device device-name driver-name)
-  (let ((identifier (starbase-open-device device-name driver-name)))
-    (and identifier
-        (let ((descriptor (make-starbase-descriptor identifier)))
-          (operation/set-coordinate-limits descriptor -1 -1 1 1)
-          (operation/set-text-height descriptor 0.1)
-          (operation/set-text-aspect descriptor 1)
-          (operation/set-text-slant descriptor 0)
-          (operation/set-text-rotation descriptor 0)
-          (descriptor->device descriptor)))))
-
-(define (operation/close device)
-  (starbase-close-device (starbase-device/identifier device)))
-
-(define (operation/flush device)
-  (starbase-flush (starbase-device/identifier device)))
-
-(define (operation/device-coordinate-limits device)
-  (let ((limits
-        (starbase-device-coordinates
-         (starbase-device/identifier device))))
-    (values (vector-ref limits 0)
-           (vector-ref limits 1)
-           (vector-ref limits 2)
-           (vector-ref limits 3))))
-
-(define (operation/coordinate-limits device)
-  (values (starbase-device/x-left device)
-         (starbase-device/y-bottom device)
-         (starbase-device/x-right device)
-         (starbase-device/y-top device)))
-
-(define (operation/set-coordinate-limits device x-left y-bottom x-right y-top)
-  (starbase-set-vdc-extent (starbase-device/identifier device)
-                          x-left y-bottom x-right y-top)
-  (set-starbase-device/x-left! device x-left)
-  (set-starbase-device/y-bottom! device y-bottom)
-  (set-starbase-device/x-right! device x-right)
-  (set-starbase-device/y-top! device y-top))
-
-(define (operation/reset-clip-rectangle device)
-  (starbase-reset-clip-rectangle (starbase-device/identifier device)))
-
-(define (operation/set-clip-rectangle device x-left y-bottom x-right y-top)
-  (starbase-set-clip-rectangle (starbase-device/identifier device)
-                              x-left y-bottom x-right y-top))
-
-(define (operation/set-drawing-mode device drawing-mode)
-  (starbase-set-drawing-mode (starbase-device/identifier device) drawing-mode))
-
-(define (operation/set-line-style device line-style)
-  (starbase-set-line-style (starbase-device/identifier device) line-style))
-
-(define (operation/clear device)
-  (starbase-clear (starbase-device/identifier device)))
-
-(define (operation/draw-point device x y)
-  (starbase-draw-point (starbase-device/identifier device) x y))
-
-(define (operation/move-cursor device x y)
-  (starbase-move-cursor (starbase-device/identifier device) x y))
-
-(define (operation/drag-cursor device x y)
-  (starbase-drag-cursor (starbase-device/identifier device) x y))
-
-(define (operation/draw-line device x-start y-start x-end y-end)
-  (starbase-draw-line (starbase-device/identifier device)
-                     x-start y-start x-end y-end))
-
-(define (operation/draw-text device x y text)
-  (starbase-draw-text (starbase-device/identifier device) x y text))
-\f
-;;; Custom Operations
-
-(define (operation/write-image-file device filename invert?)
-  (starbase-write-image-file (starbase-device/identifier device)
-                            (->namestring (merge-pathnames filename))
-                            invert?))
-
-(define (operation/text-height device)
-  (starbase-device/text-height device))
-
-(define (operation/text-aspect device)
-  (starbase-device/text-aspect device))
-
-(define (operation/text-slant device)
-  (starbase-device/text-slant device))
-
-(define (operation/text-rotation device)
-  (starbase-device/text-rotation device))
-
-(define (operation/set-text-height device height)
-  (starbase-set-text-height (starbase-device/identifier device) height)
-  (set-starbase-device/text-height! device height))
-
-(define (operation/set-text-aspect device aspect)
-  (starbase-set-text-aspect (starbase-device/identifier device) aspect)
-  (set-starbase-device/text-aspect! device aspect))
-
-(define (operation/set-text-slant device slant)
-  (starbase-set-text-slant (starbase-device/identifier device) slant)
-  (set-starbase-device/text-slant! device slant))
-
-(define (operation/set-text-rotation device rotation)
-  (starbase-set-text-rotation (starbase-device/identifier device) rotation)
-  (set-starbase-device/text-rotation! device rotation))
-
-(define (operation/color-map-size device)
-  (starbase-color-map-size (starbase-device/identifier device)))
-
-(define (operation/define-color device color-index red green blue)
-  (starbase-define-color (starbase-device/identifier device)
-                        color-index red green blue))
-
-(define (operation/set-line-color device color-index)
-  (starbase-set-line-color (starbase-device/identifier device) color-index))
\ No newline at end of file

diff --git a/src/runtime/x11graph.scm b/src/runtime/x11graph.scm
index d9e4bffb6f14e89aa6823efc0539270845fe4de6..a7817aa5daa1f480b74aaa88092c36e9eee7a04f 100644 (file)
--- a/src/runtime/x11graph.scm
+++ b/src/runtime/x11graph.scm
@@ -63,7 +63,6 @@ USA.
   (x-window-set-name 2)
   (x-window-set-position 3)
   (x-window-set-size 3)
-  (x-window-starbase-filename 1)
   (x-window-visual 1)
   (x-window-withdraw 1)
   (x-window-x-size 1)
@@ -199,7 +198,6 @@ USA.
           (set-mouse-color ,x-graphics/set-mouse-color)
           (set-mouse-shape ,x-graphics/set-mouse-shape)
           (set-window-name ,x-graphics/set-window-name)
-          (starbase-filename ,x-graphics/starbase-filename)
           (visual-info ,x-graphics/visual-info)
           (withdraw-window ,x-graphics/withdraw-window))))
   (set! display-finalizer
@@ -724,9 +722,6 @@ USA.
   (x-display-get-default (x-graphics-device/xd device)
                         resource-name class-name))
 
-(define (x-graphics/starbase-filename device)
-  (x-window-starbase-filename (x-graphics-device/xw device)))
-
 (define (x-graphics/window-id device)
   (x-window-id (x-graphics-device/xw device)))
 \f

diff --git a/src/x11/make.scm b/src/x11/make.scm
index e565d66d37887b4b8bdd86d460190b001912f4b8..979328e7454fd5201d98e337d2f93702d38f601a 100644 (file)
--- a/src/x11/make.scm
+++ b/src/x11/make.scm
@@ -48,7 +48,6 @@ Load the X11 option. |#
              x-window-set-name
              x-window-set-position
              x-window-set-size
-             ;; x-window-starbase-filename No such primitive!
              x-window-visual
              x-window-withdraw
              x-window-x-size

diff --git a/src/x11/x11-device.scm b/src/x11/x11-device.scm
index 71ab59a78b6b3487105d1ade88836ac00f6d41ee..69c5745014e173925dd351235ae19a4a2b5d7eee 100644 (file)
--- a/src/x11/x11-device.scm
+++ b/src/x11/x11-device.scm
@@ -103,7 +103,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (set-mouse-color ,x-graphics/set-mouse-color)
           (set-mouse-shape ,x-graphics/set-mouse-shape)
           (set-window-name ,x-graphics/set-window-name)
-          (starbase-filename ,x-graphics/starbase-filename)
           (visual-info ,x-graphics/visual-info)
           (withdraw-window ,x-graphics/withdraw-window))))
   (set! display-finalizer
@@ -628,13 +627,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (x-display-get-default (x-graphics-device/xd device)
                         resource-name class-name))
 
-(define (x-graphics/starbase-filename device)
-  (x-window-starbase-filename (x-graphics-device/xw device)))
-
-(define (x-window-starbase-filename window)
-  window
-  (error "Unimplemented."))
-
 (define (x-graphics/window-id device)
   (x-window-id (x-graphics-device/xw device)))
 \f

diff --git a/src/x11/x11.pkg b/src/x11/x11.pkg
index c67e3ae6bd5d466ca006157b142f98605d4ae95d..d3e4e3eaebb66c2e702d1ec1b6eafd54ba455328 100644 (file)
--- a/src/x11/x11.pkg
+++ b/src/x11/x11.pkg
@@ -265,7 +265,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          x-graphics/set-mouse-color
          x-graphics/set-mouse-shape
          x-graphics/set-window-name
-         x-graphics/starbase-filename
          x-graphics/visual-info
          x-graphics/window-id
          x-graphics/withdraw-window