diff --git a/silica/port.lisp b/silica/port.lisp index 0325abf89592db65ed43dd7f9c77e7981c8065be..3369dad4b5b46bc6f08cfaa3ad0e6150a1b75fff 100644 --- a/silica/port.lisp +++ b/silica/port.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*- -;; $fiHeader: port.lisp,v 1.28 92/12/14 15:03:36 cer Exp $ +;; $fiHeader: port.lisp,v 1.29 92/12/16 16:49:39 cer Exp $ (in-package :silica) @@ -146,16 +146,13 @@ :condition condition :sheet sheet))))) - -(defgeneric add-watcher (port watcher)) -(defgeneric remove-watcher (port watcher)) -(defgeneric reset-watcher (watcher how)) - - ;;;;;;;;;;;;;;;; (define-protocol-class graft (sheet)) +(defgeneric graft-orientation (graft)) +(defgeneric graft-units (graft)) + (defclass standard-graft (mirrored-sheet-mixin sheet-multiple-child-mixin @@ -172,6 +169,18 @@ (mm-height :reader graft-mm-height) (pixels-per-point :reader graft-pixels-per-point))) +(defgeneric graft-pixels-per-millimeter (graft)) + +(defmethod graft-pixels-per-millimeter ((graft standard-graft)) + (with-slots (mm-width pixel-width) graft + (/ pixel-width mm-width))) + +(defgeneric graft-pixels-per-inch (graft)) + +(defmethod graft-pixels-per-inch ((graft standard-graft)) + (with-slots (mm-width pixel-width) graft + (* 25.4 (/ pixel-width mm-width)))) + (defun find-graft (&key (server-path *default-server-path*) (port (find-port :server-path server-path)) (orientation :default) @@ -257,11 +266,3 @@ (defmethod graft ((object t)) nil) - -(defgeneric graft-orientation (graft)) -(defgeneric graft-units (graft)) -(defgeneric graft-width (graft)) -(defgeneric graft-height (graft)) -(defgeneric graft-pixels-per-millimeter (graft)) -(defgeneric graft-pixels-per-inch (graft)) - diff --git a/test/chess.lisp b/test/chess.lisp index 2daef264331724d1a5e03d4fa14bf035406ace42..6286707eeb7c07e1d67b0156d6fa684f33e13114 100644 --- a/test/chess.lisp +++ b/test/chess.lisp @@ -21,7 +21,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: chess.lisp,v 1.8 92/09/08 10:35:02 cer Exp $ +;; $fiHeader: chess.lisp,v 1.9 92/09/24 09:39:40 cer Exp $ (in-package :clim-user) @@ -169,7 +169,7 @@ (push (list key (xm-silica::make-pattern-from-file (format nil - "~~/stuff/gnuchess/Xchess/~a.bitmap" + "~/3rd/gnuchess/Xchess/~a.bitmap" which) (list (if square +black+ +white+) (ecase color @@ -204,7 +204,7 @@ (defun create-chess-subprocess () (multiple-value-bind (stream something pid) (excl::run-shell-command - "~/stuff/gnuchess/gnuchessr" + "~/3rd/gnuchess/gnuchessr" :wait nil :error-output :output :input :stream :output :stream) diff --git a/tk/event.lisp b/tk/event.lisp index 4fc117ae8c5de052a454317dba9c406988174f42..897d5617e91cbaff2f772190c03d9906688e39b2 100644 --- a/tk/event.lisp +++ b/tk/event.lisp @@ -20,7 +20,7 @@ ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as ;; applicable. ;; -;; $fiHeader: event.lisp,v 1.14 92/09/30 11:44:33 cer Exp $ +;; $fiHeader: event.lisp,v 1.15 92/11/20 08:46:06 cer Exp $ (in-package :tk) @@ -46,19 +46,23 @@ (defun wait-for-event (context &key timeout wait-function) - (let ((mask 0) - (fds (mapcar #'(lambda (display) - (x11::display-fd display)) - (application-context-displays context))) - (reason nil)) + (let* ((mask 0) + (fds (mapcar #'(lambda (display) + (x11::display-fd display)) + (application-context-displays context))) + result + (reason nil)) (declare (fixnum mask)) (flet ((wait-function (fd) (declare (ignore fd)) - (or (plusp (setq mask (xt_app_pending context))) - (and wait-function - (funcall wait-function) - (setq reason :wait))))) + (let ((*inside-event-wait-function* fds)) + (setq result + (catch *inside-event-wait-function* + (or (plusp (setq mask (xt_app_pending context))) + (and wait-function + (funcall wait-function) + (setq reason :wait)))))))) (let* ((interval (xt_app_interval_next_timer context)) (new-timeout (if (plusp interval) (if (and timeout diff --git a/utils/clos.lisp b/utils/clos.lisp index 077d78306d2281842dd0404fbbe192e3ba9d4c52..ed6bd947743f8e375edfe2803a30f7e952b73e51 100644 --- a/utils/clos.lisp +++ b/utils/clos.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*- -;; $fiHeader: clos.lisp,v 1.8 92/11/06 19:04:58 cer Exp $ +;; $fiHeader: clos.lisp,v 1.9 92/12/01 09:47:28 cer Exp $ ;;; ;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. @@ -268,7 +268,7 @@ (accessor-arg (first (last lambda-list))) (setf-function-name (make-setf*-function-name accessor-name))) `(define-group ,function-spec defgeneric* - (defgeneric ,function-spec ,lambda-list ,@options) + (defgeneric ,(make-setf*-function-name accessor-name) ,lambda-list ,@options) ,(expand-defsetf-for-defmethod* accessor-name accessor-arg lambda-list setf-function-name))))