Commit c8ebc741 authored by Raymond Toy's avatar Raymond Toy

Import "telent" clx

This is an import from https://github.com/sharplispers/clx, revision
6e39a0d, unchanged.

git describe --tags says:
0.7.4-19-g6e39a0d

Not yet tested with cmucl.
parent 63199010
Pipeline #665 failed with stage
in 16 minutes and 25 seconds
......@@ -40,9 +40,6 @@
;;; All WITH-STATE has to do (re)bind *Window-attributes* to a list including
;;; the new drawable. The caches are initialized to NIL and allocated as needed.
#+cmu
(ext:file-comment "$Id: attributes.lisp,v 1.8 2009/06/17 18:22:45 rtoy Rel $")
(in-package :xlib)
(eval-when (:compile-toplevel :load-toplevel :execute)
......@@ -519,13 +516,11 @@
window
(error "~S can only be set" 'window-cursor))
(defun set-window-cursor (window cursor)
(defun (setf window-cursor) (cursor window)
(change-window-attribute
window 14 (encode-type (or (member :none) cursor) cursor))
cursor)
(defsetf window-cursor set-window-cursor)
(defun window-colormap-installed-p (window)
(declare (type window window))
(declare (clx-values generalized-boolean))
......
This diff is collapsed.
......@@ -19,9 +19,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: bufmac.lisp,v 1.6 2009/06/17 18:22:45 rtoy Rel $")
(in-package :xlib)
;;; The read- macros are in buffer.lisp, because event-case depends on (most of) them.
......
;;; -*- Mode: Lisp; Package: Xlib; Log: clx.log -*-
#+cmu
(ext:file-comment "$Id: build-clx.lisp,v 1.5 2009/06/17 18:22:45 rtoy Rel $")
;;; Load this file if you want to compile CLX in its entirety.
(proclaim '(optimize (speed 3) (safety 1) (space 1)
(compilation-speed 0)))
......
;;;(in-package :xlib)
;;;(common-lisp:use-package (list :common-lisp))
#+cmu
(ext:file-comment "$Id: clx-module.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")
(provide :clx)
(load "clx:defsystem.lisp")
(load-clx (translate-logical-pathname "CLX:"))
(load-clx (translate-logical-pathname "CLX:"))
\ No newline at end of file
......@@ -76,9 +76,6 @@
;;; objects, and the additional functionality to match the C Xlib is still in
;;; progress. Bug reports should be addressed to bug-clx@expo.lcs.mit.edu.
#+cmu
(ext:file-comment "$Id: clx.lisp,v 1.16 2009/06/17 18:22:45 rtoy Rel $")
;; Note: all of the following is in the package XLIB.
(in-package :xlib)
......@@ -86,7 +83,7 @@
(pushnew :clx *features*)
(pushnew :xlib *features*)
(defparameter *version* "Telent CLX 0.7.3 + CMUCL mods, based on MIT R5.02")
(defparameter *version* "MIT R5.02")
(pushnew :clx-mit-r4 *features*)
(pushnew :clx-mit-r5 *features*)
......@@ -162,20 +159,6 @@
(deftype card4 () '(unsigned-byte 4))
#-clx-ansi-common-lisp
(deftype real (&optional (min '*) (max '*))
(labels ((convert (limit floatp)
(typecase limit
(number (if floatp (float limit 0s0) (rational limit)))
(list (map 'list #'convert limit))
(otherwise limit))))
`(or (float ,(convert min t) ,(convert max t))
(rational ,(convert min nil) ,(convert max nil)))))
#-clx-ansi-common-lisp
(deftype base-char ()
'string-char)
; Note that we are explicitly using a different rgb representation than what
; is actually transmitted in the protocol.
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: src/clx/cmudep.lisp $")
"$Header: /loaclhost/usr/local/src/cvs/clx/cmudep.lisp,v 1.1 2000/07/02 19:19:46 dan Exp $")
;;;
;;; **********************************************************************
;;;
......
......@@ -20,7 +20,6 @@
;;; implied warranty.
;;; #+ features used in this file
;;; clx-ansi-common-lisp
;;; lispm
;;; genera
;;; minima
......@@ -33,26 +32,15 @@
;;; CMU
;;; sbcl
#+cmu
(ext:file-comment "$Id: defsystem.lisp,v 1.9 2009/06/17 18:22:45 rtoy Rel $")
#+(or Genera Minima sbcl ecl)
(eval-when (:compile-toplevel :load-toplevel :execute)
(common-lisp:pushnew :clx-ansi-common-lisp common-lisp:*features*))
#+(and Genera clx-ansi-common-lisp)
#+Genera
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* si:*ansi-common-lisp-readtable*))
#-(or clx-ansi-common-lisp cmu)
(lisp:in-package :user)
#+cmu
(lisp:in-package "XLIB")
#+cmu
(export 'load-clx)
#+clx-ansi-common-lisp
(common-lisp:in-package :common-lisp-user)
......@@ -378,7 +366,7 @@
:version (pathname-version source-path)))
(binary-path (merge-pathnames binary-pathname-defaults
path))
#+clx-ansi-common-lisp (*compile-verbose* t)
(*compile-verbose* t)
(*load-verbose* t))
;; Make sure source-path and binary-path file types are distinct so
......@@ -448,9 +436,8 @@
;; Now compile and load all the files.
;; Defer compiler warnings until everything's compiled, if possible.
(#+(or clx-ansi-common-lisp CMU) with-compilation-unit
(with-compilation-unit
#+lcl3.0 lucid::with-deferred-warnings
#-(or lcl3.0 clx-ansi-common-lisp CMU) progn
()
(compile-and-load "package")
......
......@@ -18,9 +18,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: dep-allegro.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")
(in-package :xlib)
(proclaim '(declaration array-register))
......@@ -866,7 +863,7 @@
;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
`(let ((,var (list ,@elements)))
(declare (type cons ,var)
#+clx-ansi-common-lisp (dynamic-extent ,var))
(dynamic-extent ,var))
,@body))
#-lispm
......@@ -877,7 +874,7 @@
;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
`(let ((,var (list* ,@elements)))
(declare (type cons ,var)
#+clx-ansi-common-lisp (dynamic-extent ,var))
(dynamic-extent ,var))
,@body))
(declaim (inline buffer-replace))
......@@ -1033,12 +1030,10 @@
(apply #'x-cerror "Ignore" error-key :display display :error-key error-key key-vals)
(apply #'x-error error-key :display display :error-key error-key key-vals)))
#+(or clx-ansi-common-lisp excl lcl3.0 (and CMU mp))
(defun x-error (condition &rest keyargs)
(declare (dynamic-extent keyargs))
(apply #'error condition keyargs))
#+(or clx-ansi-common-lisp excl lcl3.0 CMU)
(defun x-cerror (proceed-format-string condition &rest keyargs)
(declare (dynamic-extent keyargs))
(apply #'cerror proceed-format-string condition keyargs))
......@@ -1061,33 +1056,8 @@
(ext::disable-clx-event-handling disp)))
(error condx)))
#-(or lispm ansi-common-lisp excl lcl3.0 CMU sbcl)
(defun x-error (condition &rest keyargs)
(error "X-Error: ~a"
(princ-to-string (apply #'make-condition condition keyargs))))
#-(or lispm clx-ansi-common-lisp excl lcl3.0 CMU sbcl)
(defun x-cerror (proceed-format-string condition &rest keyargs)
(cerror proceed-format-string "X-Error: ~a"
(princ-to-string (apply #'make-condition condition keyargs))))
;; version 15 of Pitman error handling defines the syntax for define-condition to be:
;; DEFINE-CONDITION name (parent-type) [({slot}*) {option}*]
;; Where option is one of: (:documentation doc-string) (:conc-name symbol-or-string)
;; or (:report exp)
#+(and excl (not clx-ansi-common-lisp))
(defmacro define-condition (name parent-types &optional slots &rest args)
`(excl::define-condition
,name (,(first parent-types))
,(mapcar #'(lambda (slot) (if (consp slot) (car slot) slot))
slots)
,@args))
#+(or clx-ansi-common-lisp excl lcl3.0 CMU sbcl)
(define-condition x-error (error) ())
;;-----------------------------------------------------------------------------
;; HOST hacking
......@@ -1276,38 +1246,6 @@ Returns a list of (host display-number screen protocol)."
(setq *temp-gcontext-cache* nil)
nil)
;;-----------------------------------------------------------------------------
;; WITH-STANDARD-IO-SYNTAX equivalent, used in (SETF WM-COMMAND)
;;-----------------------------------------------------------------------------
#-(or clx-ansi-common-lisp Genera CMU sbcl)
(defun with-standard-io-syntax-function (function)
(declare #+lispm
(sys:downward-funarg function))
(let ((*package* (find-package :user))
(*print-array* t)
(*print-base* 10)
(*print-case* :upcase)
(*print-circle* nil)
(*print-escape* t)
(*print-gensym* t)
(*print-length* nil)
(*print-level* nil)
(*print-pretty* nil)
(*print-radix* nil)
(*read-base* 10)
(*read-default-float-format* 'single-float)
(*read-suppress* nil)
)
(funcall function)))
#-(or clx-ansi-common-lisp Genera CMU sbcl)
(defmacro with-standard-io-syntax (&body body)
`(flet ((.with-standard-io-syntax-body. () ,@body))
(with-standard-io-syntax-function #'.with-standard-io-syntax-body.)))
;;-----------------------------------------------------------------------------
;; DEFAULT-KEYSYM-TRANSLATE
......@@ -1324,7 +1262,6 @@ Returns a list of (host display-number screen protocol)."
;;; When MASK-MODIFIERS is missing, all other modifiers are ignored.
;;; In ambiguous cases, the most specific translation is used.
#-(or (and clx-ansi-common-lisp (not lispm) (not allegro)) CMU sbcl)
(defun default-keysym-translate (display state object)
(declare (type display display)
(type card16 state)
......
This diff is collapsed.
......@@ -18,9 +18,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: dep-openmcl.lisp,v 1.2 2009/06/17 18:22:45 rtoy Rel $")
(in-package :xlib)
(proclaim '(declaration array-register))
......@@ -32,6 +29,17 @@
;;; Number of seconds to wait for a reply to a server request
(defparameter *reply-timeout* nil)
#-(or clx-overlapping-arrays (not clx-little-endian))
(progn
(defconstant +word-0+ 0)
(defconstant +word-1+ 1)
(defconstant +long-0+ 0)
(defconstant +long-1+ 1)
(defconstant +long-2+ 2)
(defconstant +long-3+ 3))
#-(or clx-overlapping-arrays clx-little-endian)
(progn
(defconstant +word-0+ 1)
(defconstant +word-1+ 0)
......@@ -495,8 +503,12 @@
;;; value changes.
(defun process-block (whostate predicate &rest predicate-args)
(declare (dynamic-extern predicate-args))
(apply #'ccl:process-wait whostate predicate predicate-args))
(declare (ignore whostate))
(declare (type function predicate))
(loop
(when (apply predicate predicate-args)
(return))
(ccl:process-allow-schedule)))
;;; PROCESS-WAKEUP: Check some other process' wait function.
......@@ -672,7 +684,7 @@
;; therefore DISAPPEARS when WITH-STACK-LIST is exited.
`(let ((,var (list ,@elements)))
(declare (type cons ,var)
#+clx-ansi-common-lisp (dynamic-extent ,var))
(dynamic-extent ,var))
,@body))
(defmacro with-stack-list* ((var &rest elements) &body body)
......@@ -831,7 +843,7 @@
(declare (clx-values list))
(ecase family
((:internet nil 0)
(let* ((addr (ccl::host-as-inet-host host)))
(let* ((addr (ccl:lookup-hostname host)))
(cons :internet (list
(ldb (byte 8 24) addr)
(ldb (byte 8 16) addr)
......@@ -1116,7 +1128,7 @@ Returns a list of (host display-number screen protocol)."
unit byte-lsb-first-p bit-lsb-first-p)
(declare (ignore bbuf boffset pixarray x y width height
padded-bytes-per-line bits-per-pixel unit
byte-lsb-first-p bit-lsp-first-p))
byte-lsb-first-p bit-lsb-first-p))
nil)
;;; FAST-COPY-PIXARRAY - copy part of a pixarray into another
......
......@@ -18,9 +18,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: depdefs.lisp,v 1.9 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
;;;-------------------------------------------------------------------------
......@@ -38,16 +35,6 @@
(lisp:rational x)))
(deftype rational (&optional l u) `(lisp:rational ,l ,u)))
;;; DECLAIM
#-clx-ansi-common-lisp
(defmacro declaim (&rest decl-specs)
(if (cdr decl-specs)
`(progn
,@(mapcar #'(lambda (decl-spec) `(proclaim ',decl-spec))
decl-specs))
`(proclaim ',(car decl-specs))))
;;; CLX-VALUES value1 value2 ... -- Documents the values returned by the function.
#-Genera
......@@ -63,18 +50,6 @@
#-(or lispm lcl3.0)
(declaim (declaration arglist))
;;; DYNAMIC-EXTENT var -- Tells the compiler that the rest arg var has
;;; dynamic extent and therefore can be kept on the stack and not copied to
;;; the heap, even though the value is passed out of the function.
#-(or clx-ansi-common-lisp lcl3.0)
(declaim (declaration dynamic-extent))
;;; IGNORABLE var -- Tells the compiler that the variable might or might not be used.
#-clx-ansi-common-lisp
(declaim (declaration ignorable))
;;; INDENTATION argpos1 arginden1 argpos2 arginden2 --- Tells the lisp editor how to
;;; indent calls to the function or macro containing the declaration.
......@@ -144,7 +119,7 @@
;;; You must define this to match the real byte order. It is used by
;;; overlapping array and image code.
#+(or lispm vax little-endian Minima)
#+(or lispm vax (and (not sbcl) little-endian) Minima)
(eval-when (eval compile load)
(pushnew :clx-little-endian *features*))
......@@ -171,6 +146,10 @@
(:big-endian)
(:little-endian (pushnew :clx-little-endian *features*))))
#+openmcl
(eval-when (:compile-toplevel :load-toplevel :execute)
#+little-endian-target (pushnew :clx-little-endian *features*))
;;; Steele's Common-Lisp states: "It is an error if the array specified
;;; as the :displaced-to argument does not have the same :element-type
;;; as the array being created" If this is the case on your lisp, then
......@@ -422,14 +401,7 @@ used, since NIL is the empty list.")
(defmacro def-clx-class ((name &rest options) &body slots)
(if (or (not (listp *def-clx-class-use-defclass*))
(member name *def-clx-class-use-defclass*))
(let ((clos-package #+clx-ansi-common-lisp
(find-package :common-lisp)
#-clx-ansi-common-lisp
(or (find-package :clos)
(find-package :pcl)
(let ((lisp-pkg (find-package :lisp)))
(and (find-symbol (string 'defclass) lisp-pkg)
lisp-pkg))))
(let ((clos-package (find-package :common-lisp))
(constructor t)
(constructor-args t)
(include nil)
......@@ -601,40 +573,6 @@ used, since NIL is the empty list.")
;; Printing routines.
;;-----------------------------------------------------------------------------
#-(or clx-ansi-common-lisp Genera)
(defun print-unreadable-object-function (object stream type identity function)
(declare #+lispm
(sys:downward-funarg function))
(princ "#<" stream)
(when type
(let ((type (type-of object))
(pcl-package (find-package :pcl)))
;; Handle pcl type-of lossage
(when (and pcl-package
(symbolp type)
(eq (symbol-package type) pcl-package)
(string-equal (symbol-name type) "STD-INSTANCE"))
(setq type
(funcall (intern (symbol-name 'class-name) pcl-package)
(funcall (intern (symbol-name 'class-of) pcl-package)
object))))
(prin1 type stream)))
(when (and type function) (princ " " stream))
(when function (funcall function))
(when (and (or type function) identity) (princ " " stream))
(when identity (princ "???" stream))
(princ ">" stream)
nil)
#-(or clx-ansi-common-lisp Genera)
(defmacro print-unreadable-object
((object stream &key type identity) &body body)
(if body
`(flet ((.print-unreadable-object-body. () ,@body))
(print-unreadable-object-function
,object ,stream ,type ,identity #'.print-unreadable-object-body.))
`(print-unreadable-object-function ,object ,stream ,type ,identity nil)))
;;-----------------------------------------------------------------------------
;; Image stuff
......@@ -680,7 +618,8 @@ used, since NIL is the empty list.")
;; Finding the server socket
;;-----------------------------------------------------------------------------
;; These are here because dep-openmcl.lisp and dependent.lisp both need them
;; These are here because dep-openmcl.lisp, dep-lispworks.lisp and
;; dependent.lisp need them
(defconstant +X-unix-socket-path+
"/tmp/.X11-unix/X"
"The location of the X socket")
......@@ -691,6 +630,7 @@ nil if a network socket should be opened."
(cond ((or (string= host "") (string= host "unix"))
(format nil "~A~D" +X-unix-socket-path+ display))
#+darwin
((and (> (length host) 10) (string= host "tmp/launch" :end1 10))
((or (and (> (length host) 10) (string= host "tmp/launch" :end1 10))
(and (> (length host) 29) (string= host "private/tmp/com.apple.launchd" :end1 29)))
(format nil "/~A:~D" host display))
(t nil)))
This diff is collapsed.
......@@ -18,9 +18,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: display.lisp,v 1.16 2010/11/16 19:13:55 rtoy Exp $")
(in-package :xlib)
;;; Authorizaton
......@@ -64,7 +61,8 @@
(if (null family-id)
(list nil nil nil nil nil)
(let* ((address-data (read-short-length-vector stream))
(number (parse-integer (read-short-length-string stream)))
(num-string (read-short-length-string stream))
(number (when (string/= num-string "") (parse-integer num-string)))
(name (read-short-length-string stream))
(data (read-short-length-vector stream))
(family (car (rassoc family-id *protocol-families*))))
......@@ -117,10 +115,8 @@
(read-xauth-entry stream)
(unless family (return))
(when (and (eql family protocol)
(or (equal host-address address)
(and (eql family :local)
(equal address "localhost")))
(= number display)
(equal host-address address)
(or (null number) (= number display))
(let ((pos1 (position name *known-authorizations*
:test #'string=)))
(and pos1
......@@ -328,7 +324,6 @@
,@body)))
,(if (and (null inline) (macroexpand '(use-closures) env))
`(flet ((.with-event-queue-body. () ,@body))
#+clx-ansi-common-lisp
(declare (dynamic-extent #'.with-event-queue-body.))
(with-event-queue-function
,display ,timeout #'.with-event-queue-body.))
......@@ -344,12 +339,9 @@
(declare (type display display)
(type (or null number) timeout)
(type function function)
#+clx-ansi-common-lisp
(dynamic-extent function)
;; FIXME: see SBCL bug #243
(ignorable display timeout)
#+(and lispm (not clx-ansi-common-lisp))
(sys:downward-funarg function))
(ignorable display timeout))
(with-event-queue (display :timeout timeout :inline t)
(funcall function)))
......@@ -390,38 +382,38 @@ gethostname(3) - is used instead."
;; if any, is assumed to come from the environment somehow.
(declare (type integer display))
(declare (clx-values display))
(let ((protocol
(if (member host '("" "unix") :test #'equal)
:local
protocol)))
;; Get the authorization mechanism from the environment. Handle the
;; special case of a host name of "" and "unix" which means the
;; protocol is :local
(when (null authorization-name)
(multiple-value-setq (authorization-name authorization-data)
(get-best-authorization host display protocol)))
;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
(let* ((stream (open-x-stream host display protocol))
(disp (make-buffer *output-buffer-size* #'make-display-internal
:host host :display display
:output-stream stream :input-stream stream))
(ok-p nil))
(unwind-protect
(progn
(display-connect disp
:authorization-name authorization-name
:authorization-data authorization-data)
(setf (display-authorization-name disp) authorization-name)
(setf (display-authorization-data disp) authorization-data)
(initialize-resource-allocator disp)
(initialize-predefined-atoms disp)
(initialize-extensions disp)
(when (assoc "BIG-REQUESTS" (display-extension-alist disp)
:test #'string=)
(enable-big-requests disp))
(setq ok-p t))
(unless ok-p (close-display disp :abort t)))
disp)))
;; Get the authorization mechanism from the environment. Handle the
;; special case of a host name of "" and "unix" which means the
;; protocol is :local
(when (null authorization-name)
(multiple-value-setq (authorization-name authorization-data)
(get-best-authorization host
display
(if (member host '("" "unix") :test #'equal)
:local
protocol))))
;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
(let* ((stream (open-x-stream host display protocol))
(disp (make-buffer *output-buffer-size* #'make-display-internal
:host host :display display
:output-stream stream :input-stream stream))
(ok-p nil))
(unwind-protect
(progn
(display-connect disp
:authorization-name authorization-name
:authorization-data authorization-data)
(setf (display-authorization-name disp) authorization-name)
(setf (display-authorization-data disp) authorization-data)
(initialize-resource-allocator disp)
(initialize-predefined-atoms disp)
(initialize-extensions disp)
(when (assoc "BIG-REQUESTS" (display-extension-alist disp)
:test #'string=)
(enable-big-requests disp))
(setq ok-p t))
(unless ok-p (close-display disp :abort t)))
disp))
(defun display-force-output (display)
; Output is normally buffered, this forces any buffered output to the server.
......
......@@ -11,9 +11,6 @@
;;; implied warranty.
;;;
#+cmu
(ext:file-comment "$Id")
(in-package :xlib :use '(:foreign-functions :lisp :excl))
#+allegro
......
......@@ -13,9 +13,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: excldep.lisp,v 1.5 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(eval-when (compile load eval)
......
......@@ -16,9 +16,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: fonts.lisp,v 1.7 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
;; The char-info stuff is here instead of CLX because of uses of int16->card16.
......@@ -255,7 +252,8 @@
(setf (display-font-cache display) (delete font (display-font-cache display)))
;; Close the font
(with-buffer-request (display +x-closefont+)
(resource-id id)))))
(resource-id id))
(deallocate-resource-id display id 'font))))
(defun list-font-names (display pattern &key (max-fonts 65535) (result-type 'list))
(declare (type display display)
......
......@@ -42,9 +42,6 @@
;;; because they don't run in a multi-processing shared-address space
;;; environment.
#+cmu
(ext:file-comment "$Id: gcontext.lisp,v 1.9 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
;; GContext state accessors
......
......@@ -10,9 +10,6 @@
;;; Symbolics, Inc. provides this software "as is" without
;;; express or implied warranty.
#+cmu
(ext:file-comment "$Id: generalock.lisp,v 1.5 2009/06/17 18:22:46 rtoy Rel $")
(defflavor xlib::clx-lock () (simple-recursive-normal-lock)
(:init-keywords :flavor))
......
......@@ -18,9 +18,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: graphics.lisp,v 1.7 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(defvar *inhibit-appending* nil)
......
......@@ -18,9 +18,6 @@
;;; express or implied warranty.
;;;
#+cmu
(ext:file-comment "$Id: image.lisp,v 1.13 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
(defmacro with-image-data-buffer ((buffer size) &body body)
......
......@@ -25,9 +25,6 @@
;;; -------------------------------------------------------------------------------------
;;; 12/10/87 LGO Created
#+cmu
(ext:file-comment "$Id: input.lisp,v 1.12 2009/06/17 18:22:46 rtoy Rel $")
(in-package :xlib)
;; Event Resource
......@@ -391,10 +388,7 @@
(type generalized-boolean force-output-p)
(dynamic-extent predicate-args))
(declare (type function predicate)
#+clx-ansi-common-lisp
(dynamic-extent predicate)
#+(and lispm (not clx-ansi-common-lisp))
(sys:downward-funarg predicate))
(dynamic-extent predicate))
(let ((reply-buffer nil)
(token (or (current-process) (cons nil nil))))
(declare (type (or null reply-buffer) reply-buffer))
......@@ -422,10 +416,7 @@
(declare (type display display)
(dynamic-extent predicate-args)
(type function predicate)