Skip to content
Snippets Groups Projects
Commit fd703282 authored by ram's avatar ram
Browse files

Initial revision

parent 47e140c7
No related branches found
No related tags found
No related merge requests found
R4 changes:
o Numerous bug fixes
o Multiprocess locking and error reporting made more robust
o Event queue consing reduced
o ICCCM support
R4.1 changes:
o Fix reported bugs and to include the vendor-specific
bug-fixing and performance-improving patches that I recently received.
o Code compiled with the R4 CLX will work with the R4.1X CLX, but code
compiled with the R4.1X CLX will NOT work with the R4 CLX. I made an effort
to ensure backward binary compatibility with R4 CLX so that old code doesn't
have to be recompiled to still work. It does have to be recompiled to fix
an event-queue bug, since the fix involved a change to the event-loop macro.
R4.2 changes:
o Atoms and visuals are now correctly maintained in a separate namespace from
windows, pixmaps, cursors, fonts, gcontexts, and colormaps.
o I have made an attempt to make socket code work for kcl and ibcl. I have
akcl here, but not kcl and ibcl, so it's only guesswork that kcl and ibcl
works.
o compile-clx and load-clx do more pathname merging to work around problems
in some lisp implementations. *default-pathname-defaults* is never bound
anymore.
o Some ansi common lisp stuff. If you have :ansi-common-lisp on *features*,
CLX will:
- Use the common-lisp package instead of the lisp package.
- Use the common lisp condition system, being careful not to stomp on
define-condition and type-error.
- Use declaim instead of proclaim.
- Use the dynamic-extent declaration for rest args and closures.
- Use print-unreadable-object.
o Code compiled with the R4 and R4.1 CLX will work with the R4.2 CLX, provided
you don't have :ansi-common-lisp on your features list. Code compiled with
the R4.2 CLX will NOT work with the R4 CLX.
These files contain beta code, but they have been tested to some extent under
Symbolics, TI, Lucid and Franz. The files have been given .l suffixes to keep
them within 12 characters, to keep SysV sites happy. Please rename them with
more appropriate suffixes for your system.
For Franz systems, see exclREADME.
For Symbolics systems, first rename all the .l files to .lisp. Then edit your
sys.translations file so that sys:x11;clx; points to this directory and put a
clx.system file in your sys:site;directory that has the form
(si:set-system-source-file "clx" "sys:x11;clx;defsystem.lisp")
in it. After that CLX can be compiled with the "Compile System CLX" command
and loaded with the "Load System CLX" command.
For TI systems, rename all the .l files to .lisp, and make a clx.translations
file in your sys:site; directory pointing to this directory and a
sys:site;clx.system file like the one described for symbolics systems above,
but with the defsystem file being in the clx:clx; directory. Then CLX can be
compiled with (make-system "CLX" :compile :noconfirm) and loaded with
(make-system "CLX" :noconfirm).
For Lucid systems, you should rename all the .l files to .lisp too (This might
not be possible on SysV systems). After loading the defsystem.l file, CLX can
be compiled with the (xlib:compile-clx) function and loaded with the
(xlib:load-clx) form.
The ms-patch.uu file is a patch to Lucid version 2 systems. You probably
don't need it, as you are probably running Lucid version 3 or later, but if
you are still using Lucid version 2, you need this patch. You'll need to
uudecode it to produce the binary.
For kcl systems, after loading the defsystem.l file, CLX can be compiled with
the (xlib:compile-clx) function and loaded with the (xlib:load-clx) form.
For more information, see defsystem.l and provide.l.
This diff is collapsed.
This diff is collapsed.
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-
;;; This file contains macro definitions for the BUFFER object for Common-Lisp
;;; X windows version 11
;;;
;;; TEXAS INSTRUMENTS INCORPORATED
;;; P.O. BOX 2909
;;; AUSTIN, TEXAS 78769
;;;
;;; Copyright (C) 1987 Texas Instruments Incorporated.
;;;
;;; Permission is granted to any individual or institution to use, copy, modify,
;;; and distribute this software, provided that this complete copyright and
;;; permission notice is maintained, intact, in all copies and supporting
;;; documentation.
;;;
;;; Texas Instruments Incorporated provides this software "as is" without
;;; express or implied warranty.
;;;
(in-package :xlib)
;;; The read- macros are in buffer.lisp, because event-case depends on (most of) them.
(defmacro write-card8 (byte-index item)
`(aset-card8 (the card8 ,item) buffer-bbuf (index+ buffer-boffset ,byte-index)))
(defmacro write-int8 (byte-index item)
`(aset-int8 (the int8 ,item) buffer-bbuf (index+ buffer-boffset ,byte-index)))
(defmacro write-card16 (byte-index item)
#+clx-overlapping-arrays
`(aset-card16 (the card16 ,item) buffer-wbuf
(index+ buffer-woffset (index-ash ,byte-index -1)))
#-clx-overlapping-arrays
`(aset-card16 (the card16 ,item) buffer-bbuf
(index+ buffer-boffset ,byte-index)))
(defmacro write-int16 (byte-index item)
#+clx-overlapping-arrays
`(aset-int16 (the int16 ,item) buffer-wbuf
(index+ buffer-woffset (index-ash ,byte-index -1)))
#-clx-overlapping-arrays
`(aset-int16 (the int16 ,item) buffer-bbuf
(index+ buffer-boffset ,byte-index)))
(defmacro write-card32 (byte-index item)
#+clx-overlapping-arrays
`(aset-card32 (the card32 ,item) buffer-lbuf
(index+ buffer-loffset (index-ash ,byte-index -2)))
#-clx-overlapping-arrays
`(aset-card32 (the card32 ,item) buffer-bbuf
(index+ buffer-boffset ,byte-index)))
(defmacro write-int32 (byte-index item)
#+clx-overlapping-arrays
`(aset-int32 (the int32 ,item) buffer-lbuf
(index+ buffer-loffset (index-ash ,byte-index -2)))
#-clx-overlapping-arrays
`(aset-int32 (the int32 ,item) buffer-bbuf
(index+ buffer-boffset ,byte-index)))
(defmacro write-card29 (byte-index item)
#+clx-overlapping-arrays
`(aset-card29 (the card29 ,item) buffer-lbuf
(index+ buffer-loffset (index-ash ,byte-index -2)))
#-clx-overlapping-arrays
`(aset-card29 (the card29 ,item) buffer-bbuf
(index+ buffer-boffset ,byte-index)))
(defmacro set-buffer-offset (value &environment env)
env
`(let ((.boffset. ,value))
(declare (type array-index .boffset.))
(setq buffer-boffset .boffset.)
#+clx-overlapping-arrays
,@(when (member 16 (macroexpand '(%buffer-sizes) env))
`((setq buffer-woffset (index-ash .boffset. -1))))
#+clx-overlapping-arrays
,@(when (member 32 (macroexpand '(%buffer-sizes) env))
`((setq buffer-loffset (index-ash .boffset. -2))))
#+clx-overlapping-arrays
.boffset.))
(defmacro advance-buffer-offset (value)
`(set-buffer-offset (index+ buffer-boffset ,value)))
(defmacro with-buffer-output ((buffer &key (sizes '(8 16 32)) length index) &body body)
(unless (listp sizes) (setq sizes (list sizes)))
`(let ((%buffer ,buffer))
(declare (type display %buffer))
,(declare-bufmac)
,(when length
`(when (index>= (index+ (buffer-boffset %buffer) ,length) (buffer-size %buffer))
(buffer-flush %buffer)))
(let* ((buffer-boffset (the array-index ,(or index `(buffer-boffset %buffer))))
#-clx-overlapping-arrays
(buffer-bbuf (buffer-obuf8 %buffer))
#+clx-overlapping-arrays
,@(append
(when (member 8 sizes)
`((buffer-bbuf (buffer-obuf8 %buffer))))
(when (or (member 16 sizes) (member 160 sizes))
`((buffer-woffset (index-ash buffer-boffset -1))
(buffer-wbuf (buffer-obuf16 %buffer))))
(when (member 32 sizes)
`((buffer-loffset (index-ash buffer-boffset -2))
(buffer-lbuf (buffer-obuf32 %buffer))))))
(declare (type array-index buffer-boffset))
#-clx-overlapping-arrays
(declare (type buffer-bytes buffer-bbuf)
(array-register buffer-bbuf))
#+clx-overlapping-arrays
,@(append
(when (member 8 sizes)
'((declare (type buffer-bytes buffer-bbuf)
(array-register buffer-bbuf))))
(when (member 16 sizes)
'((declare (type array-index buffer-woffset))
(declare (type buffer-words buffer-wbuf)
(array-register buffer-wbuf))))
(when (member 32 sizes)
'((declare (type array-index buffer-loffset))
(declare (type buffer-longs buffer-lbuf)
(array-register buffer-lbuf)))))
buffer-boffset
#-clx-overlapping-arrays
buffer-bbuf
#+clx-overlapping-arrays
,@(append
(when (member 8 sizes) '(buffer-bbuf))
(when (member 16 sizes) '(buffer-woffset buffer-wbuf))
(when (member 32 sizes) '(buffer-loffset buffer-lbuf)))
(macrolet ((%buffer-sizes () ',sizes))
,@body))))
;;; This macro is just used internally in buffer
(defmacro writing-buffer-chunks (type args decls &body body)
(when (> (length body) 2)
(error "writing-buffer-chunks called with too many forms"))
(let* ((size (* 8 (index-increment type)))
(form #-clx-overlapping-arrays
(first body)
#+clx-overlapping-arrays ; XXX type dependencies
(or (second body)
(first body))))
`(with-buffer-output (buffer :index boffset :sizes ,(reverse (adjoin size '(8))))
;; Loop filling the buffer
(do* (,@args
;; Number of bytes needed to output
(len ,(if (= size 8)
`(index- end start)
`(index-ash (index- end start) ,(truncate size 16)))
(index- len chunk))
;; Number of bytes available in buffer
(chunk (index-min len (index- (buffer-size buffer) buffer-boffset))
(index-min len (index- (buffer-size buffer) buffer-boffset))))
((not (index-plusp len)))
(declare ,@decls
(type array-index len chunk))
,form
(index-incf buffer-boffset chunk)
;; Flush the buffer
(when (and (index-plusp len) (index>= buffer-boffset (buffer-size buffer)))
(setf (buffer-boffset buffer) buffer-boffset)
(buffer-flush buffer)
(setq buffer-boffset (buffer-boffset buffer))
#+clx-overlapping-arrays
,(case size
(16 '(setq buffer-woffset (index-ash buffer-boffset -1)))
(32 '(setq buffer-loffset (index-ash buffer-boffset -2))))))
(setf (buffer-boffset buffer) (lround buffer-boffset)))))
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
#
# Makefile for CLX
# (X11 R4 release, Franz Allegro Common Lisp version)
#
# *************************************************************************
# * Change the next line to point to where you have Common Lisp installed *
# * (make sure the Lisp doesn't already have CLX loaded in) *
# *************************************************************************
CL = /usr/local/bin/cl
RM = /bin/rm
SHELL = /bin/sh
ECHO = /bin/echo
TAGS = /usr/local/lib/emacs/etc/etags
# Name of dumped lisp
CLX = CLX
CLOPTS = -qq
# Use this one for Suns
CFLAGS = -O -DUNIXCONN
# Use this one for Silicon Graphics & Mips Inc MIPS based machines
# CFLAGS = -O -G 0 -I/usr/include/bsd
# Use this one for DEC MIPS based machines
# CFLAGS = -O -G 0 -DUNIXCONN
# Use this one for HP machines
# CFLAGS = -O -DSYSV -DUNIXCONN
# Lisp optimization for compiling
SPEED = 3
SAFETY = 0
C_SRC = excldep.c socket.c
C_OBJS = excldep.o socket.o
L_OBJS = excldep.fasl defsystem.fasl depdefs.fasl clx.fasl dependent.fasl \
exclcmac.fasl macros.fasl bufmac.fasl buffer.fasl display.fasl \
gcontext.fasl requests.fasl input.fasl fonts.fasl graphics.fasl \
text.fasl attributes.fasl translate.fasl keysyms.fasl manager.fasl \
image.fasl resource.fasl
L_NOMACROS_OBJS = excldep.fasl depdefs.fasl clx.fasl dependent.fasl \
buffer.fasl display.fasl gcontext.fasl \
requests.fasl input.fasl fonts.fasl graphics.fasl text.fasl \
attributes.fasl translate.fasl keysyms.fasl manager.fasl image.fasl \
resource.fasl
L_SRC = defsystem.cl depdefs.cl clx.cl dependent.cl exclcmac.cl \
macros.cl bufmac.cl buffer.cl display.cl gcontext.cl \
requests.cl input.cl fonts.cl graphics.cl text.cl \
attributes.cl translate.cl keysyms.cl manager.cl image.cl \
resource.cl
all: $(C_OBJS) compile-CLX cat
clos: $(C_OBJS) compile-closified-CLX cat
CLX: $(C_OBJS) compile-CLX load-CLX
c: $(C_OBJS)
lisp: compile-CLX
compile-CLX: $(C_OBJS)
$(ECHO) " \
(set-case-mode :case-sensitive-lower) \
(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)))) \
(compile-file-if-needed \"excldep\") \
(compile-file-if-needed \"defsystem\") \
(load \"defsystem\") \
#+allegro (compile-system :clx) \
#-allegro (xlib::compile-clx) \
#+allegro (compile-system :clx-debug)" \
| $(CL) $(CLOPTS) -batch
compile-closified-CLX: $(C_OBJS)
$(ECHO) " \
(proclaim '(optimize (speed $(SPEED)) (safety $(SAFETY)))) \
(setq excl::*print-nickname* t) \
(unless (or (find-package 'clos) (find-package 'pcl)) \
(let ((spread (sys:gsgc-parameter :generation-spread))) \
(setf (sys:gsgc-parameter :generation-spread) 1) \
(require :pcl) \
(provide :pcl) \
(gc) (gc) \
(setf (sys:gsgc-parameter :generation-spread) spread))) \
(compile-file-if-needed \"excldep\") \
(compile-file-if-needed \"defsystem\") \
(load \"defsystem\") \
#+allegro (compile-system :clx) \
#-allegro (xlib::compile-clx) \
#+allegro (compile-system :clx-debug)" \
| $(CL) $(CLOPTS) -batch
cat:
-cat $(L_NOMACROS_OBJS) > CLX.fasl
load-CLX:
$(ECHO) '(load "defsystem")' \
"(let (#+allegro (spread (sys:gsgc-parameter :generation-spread)))" \
" #+allegro (setf (sys:gsgc-parameter :generation-spread) 1)" \
" #+allegro (load-system :clx)" \
" #-allegro (xlib::load-clx)" \
" #+allegro (gc :tenure)" \
" #+allegro (setf (sys:gsgc-parameter :generation-spread) spread)" \
")" \
'#+allegro (gc t)' \
'(dumplisp :name "$(CLX)" #+allegro :checkpoint #+allegro nil)' \
'(exit)' | $(CL) $(CLOPTS)
clean:
$(RM) -f *.fasl debug/*.fasl $(CLX) core $(C_OBJS)
install:
mv CLX.fasl $(DEST)/clx.fasl
mv *.o $(DEST)
tags:
$(TAGS) $(L_SRC) $(C_SRC)
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment