;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;; $Id: gtk.lisp,v 1.74 2007/06/20 10:19:47 espen Exp $
+;; $Id: gtk.lisp,v 1.76 2007/06/25 10:36:43 espen Exp $
(in-package "GTK")
(sb-unix:fd-zero read-fds)
(sb-unix:fd-set fd read-fds)
- (unless (zerop (sb-unix:unix-fast-select
- (1+ fd) (sb-alien:addr read-fds) nil nil
- seconds microseconds))
- (if (peek-char nil (car socket) nil)
- :input
- :eof)))))
+ (let ((num-fds-changed
+ (sb-unix:unix-fast-select
+ (1+ fd) (sb-alien:addr read-fds) nil nil
+ seconds microseconds)))
+ (unless (or (not num-fds-changed) (zerop num-fds-changed))
+ (if (peek-char nil (car socket) nil)
+ :input
+ :eof))))))
(defun %init-async-event-handling (display)
(let ((style #?(or (featurep :cmu) (sbcl< 1 0 6)) :fd-handler
(defbinding %window-set-geometry-hints () nil
(window window)
+ (widget (or widget null))
(geometry gdk:geometry)
(geometry-mask gdk:window-hints))
-(defun window-set-geometry-hints (window &key min-width min-height
+(defun window-set-geometry-hints (window &key widget min-width min-height
max-width max-height base-width base-height
- width-inc height-inc min-aspect max-aspect
- (gravity nil gravity-p) min-size max-size)
+ width-inc height-inc gravity
+ aspect (min-aspect aspect) (max-aspect aspect))
(let ((geometry (make-instance 'gdk:geometry
:min-width (or min-width -1)
:min-height (or min-height -1)
:width-inc (or width-inc 0)
:height-inc (or height-inc 0)
:min-aspect (or min-aspect 0)
- :max-aspect (or max-aspect 0)
- :gravity gravity))
+ :max-aspect (or max-aspect 0)))
(mask ()))
- (when (or min-size min-width min-height)
+ (when (or min-width min-height)
(push :min-size mask))
- (when (or max-size max-width max-height)
+ (when (or max-width max-height)
(push :max-size mask))
(when (or base-width base-height)
(push :base-size mask))
(push :resize-inc mask))
(when (or min-aspect max-aspect)
(push :aspect mask))
- (when gravity-p
- (push :win-gravity mask))
- (%window-set-geometry-hints window geometry mask)))
+ (when gravity
+ (push :win-gravity mask)
+ (setf (gdk:geometry-gravity geometry) gravity))
+ (%window-set-geometry-hints window widget geometry mask)))
(defbinding window-list-toplevels () (glist (copy-of window))
"Returns a list of all existing toplevel windows.")