X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/6b4653285642d4a2c080ed1d0eaf69813a594016..d8dd2e76465c00d5a4519bcc1ca8ef12604a7bf9:/gtk/gtk.lisp diff --git a/gtk/gtk.lisp b/gtk/gtk.lisp index d4cc2dd..5cf18f0 100644 --- a/gtk/gtk.lisp +++ b/gtk/gtk.lisp @@ -20,7 +20,7 @@ ;; 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") @@ -88,12 +88,14 @@ (defun socket-status (socket seconds microseconds) (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 @@ -1400,13 +1402,14 @@ (defbinding window-set-default-size (window width height) int (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) @@ -1417,12 +1420,11 @@ (defun window-set-geometry-hints (window &key min-width min-height :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)) @@ -1430,9 +1432,10 @@ (defun window-set-geometry-hints (window &key min-width min-height (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.")