Commit 4a6067af authored by cer's avatar cer
Browse files

fixes

parent abcc0207
# $fiHeader: Makefile,v 1.8 92/01/31 17:51:05 cer Exp Locker: cer $
SOMEDIRS=sys utils silica clim demo
DIRS=$(SOMEDIRS) xlib tk xm-silica misc
DEVICE=/dev/null
CL=/net/vapor/usr/composer2/composer2
# $fiHeader: Makefile,v 1.9 92/01/31 17:52:53 cer Exp $
#
# Makefile for CLIM 2.0
#
CL = /misc/jdi/cl
DUMP-CL = /misc/jdi/cl
CLOPTS = -qq
# Lisp optimization for compiling
SPEED = 3
SAFETY = 1
# Name of dumped lisp
CLIM = ./slim
CLIM-SMALL = ./slim-small
PUBDIRS = sys utils silica clim demo test
DIRS = $(PUBDIRS) xlib tk xm-silica misc
DEVICE = /dev/null
RM = /bin/rm
CAT = /bin/cat
ECHO = /bin/echo
MV = /usr/fi/mv-nfs
TAGS = /usr/fi/lib/emacs/etc/etags
TMP = /usr/tmp
#
# "Compile time objects" -- these go into clim-debug.fasl
#
DEBUG-OBJS = xlib/xlib.fasl
#
# "Load time objects" -- these go into clim.fasl
#
CLIM-UTILS-OBJS = utils/excl-verification.fasl \
utils/lisp-package-fixups.fasl \
utils/defpackage.fasl \
utils/packages.fasl \
utils/defun-utilities.fasl \
utils/reader.fasl \
utils/clos-patches.fasl \
utils/clos.fasl \
utils/utilities.fasl \
utils/lisp-utilities.fasl \
utils/processes.fasl \
utils/queue.fasl \
utils/protocols.fasl \
utils/autoconstructor.fasl \
utils/clim-streams.fasl \
utils/excl-streams.fasl \
utils/clim-macros.fasl \
utils/transformations.fasl \
utils/regions.fasl \
utils/region-arithmetic.fasl \
utils/designs.fasl
CLIM-SILICA-OBJS = silica/classes.fasl \
silica/text-style.fasl \
silica/macros.fasl \
silica/sheet.fasl \
silica/mirror.fasl \
silica/event.fasl \
silica/port.fasl \
silica/medium.fasl \
silica/graphics.fasl \
silica/std-sheet.fasl \
silica/layout.fasl \
silica/db-layout.fasl \
silica/db-box.fasl \
silica/db-table.fasl \
silica/gadgets.fasl \
silica/db-scroll.fasl
CLIM-STANDALONE-OBJS = clim/shift-mask.fasl \
clim/defprotocol.fasl \
clim/stream-defprotocols.fasl \
clim/defresource.fasl \
clim/temp-strings.fasl \
clim/clim-defs.fasl \
clim/stipples.fasl \
clim/stream-class-defs.fasl \
clim/interactive-defs.fasl \
clim/cursor.fasl \
clim/view-defs.fasl \
clim/input-defs.fasl \
clim/input-protocol.fasl \
clim/output-protocol.fasl \
clim/window-protocol.fasl \
clim/output-recording-protocol.fasl \
clim/output-recording-defs.fasl \
clim/interactive-protocol.fasl \
clim/input-editor-commands.fasl \
clim/formatted-output-defs.fasl \
clim/incremental-redisplay.fasl \
clim/coordinate-sorted-set.fasl \
clim/window-stream.fasl \
clim/completer.fasl \
clim/ptypes1.fasl \
clim/presentations.fasl \
clim/translators.fasl \
clim/histories.fasl \
clim/ptypes2.fasl \
clim/standard-types.fasl \
clim/table-formatting.fasl \
clim/graph-formatting.fasl \
clim/surround-output.fasl \
clim/text-formatting.fasl \
clim/tracking-pointer.fasl \
clim/dragging-output.fasl \
clim/db-stream.fasl \
clim/gadget-output.fasl \
clim/accept.fasl \
clim/present.fasl \
clim/command.fasl \
clim/command-processor.fasl \
clim/basic-translators.fasl \
clim/frames.fasl \
clim/menus.fasl \
clim/accept-values.fasl \
clim/item-list-manager.fasl \
clim/pixmap-streams.fasl \
clim/stream-trampolines.fasl
XLIB-CLIM-OBJS = xlib/pkg.fasl \
xlib/ffi.fasl \
xlib/x11-keysyms.fasl \
xlib/last.fasl
XT-CLIM-OBJS = tk/pkg.fasl \
tk/foreign-obj.fasl \
tk/macros.fasl \
tk/xlib.fasl \
tk/font.fasl \
tk/gcontext.fasl \
tk/graphics.fasl \
tk/xtk.fasl \
tk/meta-tk.fasl \
tk/make-classes.fasl \
tk/foreign.fasl \
tk/widget.fasl \
tk/resources.fasl \
tk/event.fasl \
tk/callbacks.fasl \
tk/xt-classes.fasl \
tk/xt-init.fasl
XM-CLIM-OBJS = tk/xm-classes.fasl \
tk/xm-init.fasl \
tk/xm-widgets.fasl \
tk/xm-font-list.fasl \
tk/xm-protocols.fasl \
tk/convenience.fasl \
tk/make-widget.fasl
MOTIF-CLIM-OBJS = xm-silica/pkg.fasl \
xm-silica/xt-silica.fasl \
xm-silica/xm-silica.fasl \
xm-silica/xt-graphics.fasl \
xm-silica/xm-graphics.fasl \
xm-silica/image.fasl \
xm-silica/xt-frames.fasl \
xm-silica/xm-frames.fasl \
xm-silica/xt-gadgets.fasl \
xm-silica/xm-gadgets.fasl \
xm-silica/xm-menus.fasl \
xm-silica/xt-pixmaps.fasl
default: compile
OL-CLIM-OBJS = tk/ol-classes.fasl \
tk/ol-init.fasl \
tk/ol-callbacks.fasl \
tk/make-widget.fasl
compile : FRC
OPENLOOK-CLIM-OBJS = xm-silica/pkg.fasl \
xm-silica/xt-silica.fasl \
xm-silica/ol-silica.fasl \
xm-silica/xt-graphics.fasl \
xm-silica/ol-graphics.fasl \
xm-silica/image.fasl \
xm-silica/xt-frames.fasl \
xm-silica/ol-frames.fasl \
xm-silica/xt-gadgets.fasl \
xm-silica/ol-gadgets.fasl \
xm-silica/xt-pixmaps.fasl
MOTIF-OBJS = $(CLIM-UTILS-OBJS) $(CLIM-SILICA-OBJS) $(CLIM-STANDALONE-OBJS) \
$(XLIB-CLIM-OBJS) $(XT-CLIM-OBJS) $(XM-CLIM-OBJS) \
$(MOTIF-CLIM-OBJS)
OPENLOOK-OBJS = $(CLIM-UTILS-OBJS) $(CLIM-SILICA-OBJS) \
$(CLIM-STANDALONE-OBJS) $(XLIB-CLIM-OBJS) $(XT-CLIM-OBJS) \
$(OL-CLIM-OBJS) $(OPENLOOK-CLIM-OBJS)
all: compile cat clim
compile: FORCE
$(ECHO) " \
(load \"misc/go-xm.cl\")" | $(CL) $(CLOPTS) -batch
(setq *ignore-package-name-case* t) \
(set-case-mode :case-insensitive-lower) \
(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)))) \
(load \"misc/compile-xm.lisp\")" | $(CL) $(CLOPTS) -batch
clean : FRC
find $(DIRS) -name "*.fasl" -exec $(RM) "{}" \;
clim.fasl: $(MOTIF-OBJS)
$(CAT) $(MOTIF-OBJS) > $(TMP)/clim.fasl_`whoami`
mv-nfs $(TMP)/clim.fasl_`whoami` clim.fasl
FRC :
clim-debug.fasl: $(MOTIF-OBJS)
$(CAT) $(DEBUG-OBJS) > $(TMP)/clim-debug.fasl_`whoami`
mv-nfs $(TMP)/clim-debug.fasl_`whoami` clim-debug.fasl
cat: clim.fasl clim-debug.fasl
swm-tape:
tar cf $(DEVICE) `find $(SOMEDIRS) '(' -name "*.cl" -o -name "*.lisp" ')' -print`
clim: FORCE
$(ECHO) " \
(setq *ignore-package-name-case* t) \
(set-case-mode :case-insensitive-lower) \
(load \"misc/dev-load-xm.lisp\") \
(load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch
$(MV) $(TMP)/clim.temp_`whoami` $(CLIM)
clim-small: FORCE
$(ECHO) " \
(setq *ignore-package-name-case* t) \
(set-case-mode :case-insensitive-lower) \
(load \"misc/load-xm.lisp\") \
(load \"misc/dump.lisp\")" | $(DUMP-CL) $(CLOPTS) -batch
$(MV) $(TMP)/clim.temp_`whoami` $(CLIM-SMALL)
xm-composer:
cd tk ; $(MAKE) xm-composer
xm-dcl:
cd tk ; $(MAKE) xm-dcl
dist :
clean:
find $(DIRS) -name "*.fasl" -ls | xargs rm -f ; rm -f clim.fasl
tags:
$(TAGS) `find $(DIRS) '(' -name "*.cl" -o -name "*.lisp" ')' -print`
swm-tape:
tar cf $(DEVICE) `find $(PUBDIRS) '(' -name "*.cl" -o -name "*.lisp" ')' -print`
dist:
gtar -z -cf - \
*/*.lisp *.lisp Makefile \
> Dist/src.tar.Z
rcscheck:
rcscheck $(DIRS) | grep -v .fasl
rcscheck $(DIRS) | grep -v .fasl
# For the day the make dist happens.
echo_src_files:
@find . '(' -name '*.cl' -o -name '*.lisp' ')' -print
FORCE:
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
;; $fiHeader: menus.lisp,v 1.8 92/02/05 21:45:43 cer Exp Locker: cer $
;; $fiHeader: menus.lisp,v 1.9 92/02/14 18:58:01 cer Exp Locker: cer $
(in-package :clim-internals)
......@@ -64,7 +64,7 @@
;; into a menu is required to use with-end-of-line-action and with-end-of-page-action
;; or set the size first itself.
:initializer (initialize-menu (sheet-port menu) menu associated-window)
:matcher (or (null root)
:matcher (or #+ignore (null root) #-ignore nil
;; horrible kludge in the case where no associated window is passed in.
(eql (sheet-port menu) (sheet-port root))))
......
......@@ -18,10 +18,10 @@
;;;
;;; $Author: cer $
;;; $Source: /repo/cvs.copy/clim2/sys/defsystem.lisp,v $
;;; $Revision: 1.2 $
;;; $Date: 1992/02/08 14:59:27 $
;;; $Revision: 1.3 $
;;; $Date: 1992/02/16 20:55:38 $
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Hacked by smL to convert it to lisp from C.
;;; No, seriously folks. Lots of changes here. Added support for multiple
;;; source file-types. Cleaned up a *lot* of code.
......@@ -30,19 +30,19 @@
;;; Added support for different modules applicable only in certain features.
;;; -smL 17-April-89
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Added support for sysdcl files.
;;; -smL
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Cleaned up a lot of syntax. Made some fields of the defsystem macro be eval'ed.
;;; -smL
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Added "temporary" hack *load-all-before-compile*.
;;; -smL
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Incorporated changes from Bill York @ ILA to deal with Genera.
;;; Added the :default-binary-pathname option to defsystem and :binary-pathname
;;; to each module.
......@@ -55,12 +55,12 @@
;;; Fixed the spelling of "propagate".
;;; -smL
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Fixed a bug that caused many too many calls to file-write-date during a
;;; load-system.
;;; -smL
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Incorporated changes from Bill York <york@ila-west.dialnet.symbolics.com>
;;; to make string --> pathname coersion cleaner under Genera.
;;; Also made some trivial changes to the messages printed out when *tracep*
......@@ -75,7 +75,7 @@
;;; load-system and compile-system now return the system name.
;;; -smL
;;;
;;; $Revision: 1.2 $
;;; $Revision: 1.3 $
;;; Fixed bug with pretty-pathname-component. Added message when compiling a
;;; file in Genera, since it doesn't print one by default. Fixed a small bug
;;; with handling of *features*. Fixed a bug with *tracep*.
......@@ -91,7 +91,7 @@
;;;
;;;-----------------------------------------------------------
;; $fiHeader: defsystem.lisp,v 1.6 91/03/26 12:59:59 cer Exp $
;; $fiHeader: defsystem.lisp,v 1.2 92/02/08 14:59:27 cer Exp $
;; Add a feature for ANSI-adhering Lisps. So far, only Apple's
;; version 2.0 tries to do adhere to the ANSI spec instead of CLtL rev 1.
......@@ -1541,9 +1541,9 @@ verify that each already loaded subsystem is up-to-date, reloading it if need be
,@(and old-safety ,safety `((safety ,old-safety))))))))
#|
;;; Write (Franz only?) Makefile description for constructiong big FASL
;;; from system definition. 20-21 August 1990 by Richard Lamson
(defun write-Makefile-for-system (system)
(unless (system-p system)
(setf system (find-system system)))
......@@ -1615,4 +1615,4 @@ verify that each already loaded subsystem is up-to-date, reloading it if need be
(and pfp
(format nil "~VT~A.~A" indentation pfp bin-type))))
(list file-list-name)))))
|#
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*-
;; $fiHeader: sysdcl.lisp,v 1.6 91/03/26 13:00:01 cer Exp $
;; $fiHeader: sysdcl.lisp,v 1.2 92/02/08 14:59:29 cer Exp $
(in-package #-ANSI-90 "USER" #+ANSI-90 :cl-user)
......@@ -323,13 +323,16 @@
:needed-systems (clim-standalone)
:load-before-compile (clim-standalone))
("pkg")
#+ignore
("ffi" :eval-after (mapc #'load '("xlib/xlib.lisp" "xlib/x11-keysyms.lisp"
"xlib/last.lisp")))
("ffi")
("xlib")
("x11-keysyms")
("last"))
#+Allegro
(defsys::defsystem tk-clim
(defsys::defsystem xt-clim
(:default-pathname (frob-pathname "tk")
:default-binary-pathname (frob-pathname "tk")
:needed-systems (xlib-clim)
......@@ -354,9 +357,16 @@
("resources")
("event")
("callbacks")
("xt-classes")
("xt-init"))
(defsys::defsystem xm-clim
(:default-pathname (frob-pathname "tk")
:default-binary-pathname (frob-pathname "tk")
:needed-systems (xt-clim)
:load-before-compile (xt-clim))
;; Motif specific stuff
("load-xm")
("xm-classes")
("xm-init")
("xm-widgets")
("xm-font-list")
......@@ -371,32 +381,9 @@
(defsys::defsystem ol-clim
(:default-pathname (frob-pathname "tk")
:default-binary-pathname (frob-pathname "tk")
:needed-systems (xlib-clim)
:load-before-compile (xlib-clim))
(|pkg|)
(|foreign-obj|)
(|macros|)
;; Xlib stuff
(|xlib|)
(|font|)
(|gcontext|)
(|graphics|)
;; Toolkit stuff
(|xtk|)
(|meta-tk|)
(|make-classes|)
(|foreign|)
(|widget|)
(|resources|)
(|event|)
(|callbacks|)
(|load-ol|)
:needed-systems (xt-clim)
:load-before-compile (xt-clim))
(|ol-classes|)
(|ol-init|)
(|ol-callbacks|)
#+ignore(|ol-examples|)
......@@ -407,8 +394,8 @@
(defsys::defsystem motif-clim
(:default-pathname (frob-pathname "xm-silica")
:default-binary-pathname (frob-pathname "xm-silica")
:needed-systems (tk-clim)
:load-before-compile (tk-clim))
:needed-systems (xm-clim)
:load-before-compile (xm-clim))
("pkg")
("xt-silica")
("xm-silica")
......
;; -*- mode: common-lisp; package: clim -*-
;;
;; -[]-
;;
;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved.
;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
;; given in confidence by Franz, Inc. pursuant to a written license
;; agreement, and may be stored and used only in accordance with the terms
;; of such license.
;;
;; Restricted Rights Legend
;; ------------------------
;; Use, duplication, and disclosure of the software, data and information
;; contained herein by any agency, department or entity of the U.S.
;; Government are subject to restrictions of Restricted Rights for
;; Commercial Software developed at private expense as specified in FAR
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable.
;;
;; $fiHeader$
(in-package :clim)
(define-application-frame chess-board ()
......
;; -*- mode: common-lisp; package: silica -*-
;;
;; -[]-
;;
;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA All rights reserved.
;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc. They are
;; given in confidence by Franz, Inc. pursuant to a written license
;; agreement, and may be stored and used only in accordance with the terms
;; of such license.
;;
;; Restricted Rights Legend
;; ------------------------
;; Use, duplication, and disclosure of the software, data and information
;; contained herein by any agency, department or entity of the U.S.
;; Government are subject to restrictions of Restricted Rights for
;; Commercial Software developed at private expense as specified in FAR
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable.
;;
;; $fiHeader$
(in-package :silica)
(setq port (find-port))
......
......@@ -19,6 +19,8 @@
;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
;; applicable.
;;
;; $fiHeader$
(in-package :clim-internals)
(define-application-frame test-frame ()
......
......@@ -20,7 +20,7 @@
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable.
;;
;; $fiHeader: xt-gadgets.lisp,v 1.3 92/02/05 21:45:29 cer Exp Locker: cer $
;; $fiHeader: xt-gadgets.lisp,v 1.4 92/02/14 18:57:46 cer Exp Locker: cer $
(in-package :xm-silica)
......@@ -70,19 +70,19 @@
;; Background can either be a pixel of a bitmap
;; Foreground has to be a pixel
;; clx-decode-gadget-background
;; clx-decode-gadget-foreground
;; decode-gadget-background
;; decode-gadget-foreground
(when silica::background
(with-sheet-medium (medium sheet)
(setf initargs
(append (clx-decode-gadget-background medium sheet silica::background)
(append (decode-gadget-background medium sheet silica::background)
initargs))))
(when silica::foreground
(with-sheet-medium (medium sheet)
(setf initargs
(append (clx-decode-gadget-foreground medium sheet silica::foreground)
(append (decode-gadget-foreground medium sheet silica::foreground)
initargs))))
(when silica::text-style
......@@ -91,20 +91,18 @@
(values class initargs))))
(defmethod clx-decode-gadget-background (medium sheet ink)
(defmethod decode-gadget-background (medium sheet ink)
(declare (ignore sheet))
(let ((gc (clx-decode-ink ink medium)))
(let ((gc (decode-ink ink medium)))
(if (tk::gcontext-tile gc)
(list :background-pixmap (tk::gcontext-tile gc))
(list :background (tk::gcontext-foreground gc)))))
(defmethod clx-decode-gadget-foreground (medium sheet ink)
(defmethod decode-gadget-foreground (medium sheet ink)
(declare (ignore sheet))
(let ((gc (clx-decode-ink ink medium)))
(if (tk::gcontext-tile gc)
(error "Gadget foreground cannot be pixmap")
(list :foreground (tk::gcontext-foreground gc)))))
(let ((pixel (decode-color medium ink)))
(list :foreground pixel)))
;; This needs to be somewhere.
......
......@@ -20,7 +20,7 @@
;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
;; applicable.
;;
;; $fiHeader: xt-graphics.lisp,v 1.5 92/02/05 21:45:30 cer Exp Locker: cer $
;; $fiHeader: xt-graphics.lisp,v 1.6 92/02/14 18:57:47 cer Exp Locker: cer $
(in-package :xm-silica)
......@@ -28,9 +28,13 @@
((foreground-gcontext :reader medium-foreground-gcontext :initform nil)
(background-gcontext :reader medium-background-gcontext :initform nil)
(flipping-gcontext :reader medium-flipping-gcontext :initform nil)
(sheet :accessor medium-sheet)
(drawable :initform nil :writer (setf medium-drawable))
(ink-table :initform (make-hash-table))))
(sheet :accessor medium-sheet)
(drawable :initform nil)
(color-p)
(ink-table :initform (make-hash-table))
(stipple-gcontext :initform nil) ; These don't belong here.
(white-pixel :initform 0)
(black-pixel :initform 1)))
(defmethod medium-drawable ((medium xt-medium))
(with-slots (drawable sheet) medium
......@@ -44,27 +48,40 @@
(tk::widget-window mirror nil))
(defmethod engraft-medium :after ((medium xt-medium) (port xt-port) sheet)
(with-slots
(foreground-gcontext background-gcontext flipping-gcontext)
(with-slots (foreground-gcontext background-gcontext flipping-gcontext color-p
drawable stipple-gcontext white-pixel black-pixel)
medium
(setf (medium-sheet medium) sheet)
(let ((drawable (tk::display-root-window (port-display port))))
(unless foreground-gcontext
(setf foreground-gcontext (tk::make-instance 'tk::gcontext :drawable drawable)))
(unless background-gcontext
(setf background-gcontext (tk::make-instance 'tk::gcontext
:drawable drawable)))
(unless flipping-gcontext
(setf flipping-gcontext
(tk::make-instance 'tk::gcontext
:function boole-xor
:drawable drawable)))