Skip to content
Snippets Groups Projects
Commit 4d2f43a9 authored by Andreas Fuchs's avatar Andreas Fuchs
Browse files

spr36199: Restrict window sizes to max available space on screen.

* Adjust the graft size to compute the available screen height/width sans
  task bar.
* Make sure that resize-frame works only on the window's client area (which is 
  reduced by menu bars and window decorations).
parent 5a814340
No related branches found
No related tags found
No related merge requests found
......@@ -3,6 +3,11 @@
don't forget to change the version in utils/packages.lisp if you do anything
user visible.
*******************************************************************************
2009-09-15 Andreas Fuchs <afuchs@franz.com>
* aclpc/acl-mirror.lisp: Restrict window sizes to the maximum available client
rect size for each window. (spr36199).
2009-09-10 Andreas Fuchs <afuchs@franz.com>
* tk/font.lisp: Fix (obvious, in retrospect) printer error in warning about missing
......
......@@ -36,38 +36,61 @@
;;--- This isn't really right, all ports only have kludges for this
(defmethod sheet-shell (sheet) sheet)
(defun win-full-screen-area ()
"Get the area of the screen that can be occupied by windows (screen - task/tool bars)."
(let ((rect (ct:ccallocate win:rect)))
(win:SystemParametersInfo win:SPI_GETWORKAREA 0 rect 0)
(values (coordinate (ct:cref win:rect rect win::left))
(coordinate (ct:cref win:rect rect win::top))
(coordinate (ct:cref win:rect rect win::right))
(coordinate (ct:cref win:rect rect win::bottom)))))
(defmethod realize-graft ((port acl-port) graft)
(let ((screen (slot-value (screen-device *acl-port*) 'device-handle1)))
(setf (port-screen port) screen)
(init-cursors)
(with-slots (silica::pixels-per-point
silica::pixel-width
silica::pixel-height
silica::mm-width
silica::mm-height
silica::units) graft
(with-dc (screen dc)
(let ((screen-width (win:GetSystemMetrics win:SM_CXSCREEN))
(screen-height (win:GetSystemMetrics win:SM_CYSCREEN))
(logpixelsx (win:GetDeviceCaps dc win:LOGPIXELSX))
(logpixelsy (win:GetDeviceCaps dc win:LOGPIXELSY)))
(setf silica::pixel-width screen-width
silica::pixel-height screen-height
silica::mm-width (round (* screen-width 25.4s0) logpixelsx)
silica::mm-height (round (* screen-height 25.4s0) logpixelsy))
(let* ((ppp (/ logpixelsy 72s0))
(rounded-ppp (round ppp)))
(setf silica::pixels-per-point
(if (< (abs (- ppp rounded-ppp)) .1s0) rounded-ppp ppp)))
(setf (sheet-region graft)
(ecase silica::units
((:device :pixel)
(make-bounding-rectangle
0 0
silica::pixel-width silica::pixel-height))))
(setf (sheet-native-transformation graft) +identity-transformation+)
(setf (sheet-direct-mirror graft) screen)
(update-mirror-transformation port graft))))))
(setf (port-screen port) screen)
(init-cursors)
(with-slots (silica::pixels-per-point
silica::pixel-width
silica::pixel-height
silica::mm-width
silica::mm-height
silica::units) graft
(with-dc (screen dc)
(multiple-value-bind (screen-left screen-top screen-right screen-bottom)
(win-full-screen-area)
(let ((screen-width (- screen-left screen-right))
(screen-height (- screen-bottom screen-top))
(logpixelsx (win:GetDeviceCaps dc win:LOGPIXELSX))
(logpixelsy (win:GetDeviceCaps dc win:LOGPIXELSY)))
(setf silica::pixel-width (- screen-left screen-right)
silica::pixel-height (- screen-bottom screen-top)
silica::mm-width (round (* screen-width 25.4s0) logpixelsx)
silica::mm-height (round (* screen-height 25.4s0) logpixelsy))
(let* ((ppp (/ logpixelsy 72s0))
(rounded-ppp (round ppp)))
(setf silica::pixels-per-point
(if (< (abs (- ppp rounded-ppp)) .1s0) rounded-ppp ppp)))
(setf (sheet-region graft)
(ecase silica::units
((:device :pixel)
(make-bounding-rectangle
screen-left screen-top screen-right screen-bottom))))
(format *trace-output* "~&height: ~A vs. real height: ~A~%"
screen-height (- screen-bottom screen-top))
(setf (sheet-native-transformation graft) +identity-transformation+)
(setf (sheet-direct-mirror graft) screen)
(update-mirror-transformation port graft)))))))
(defmethod resize-sheet :around ((sheet acl-top-level-sheet) width height)
"Restrict sheet sizes to the actual available client area."
(multiple-value-bind (-left -top dw dh)
(get-nonclient-deltas sheet)
(declare (ignore -left -top))
(let* ((graft-br (sheet-region (graft sheet)))
(gw (bounding-rectangle-width graft-br))
(gh (bounding-rectangle-height graft-br)))
(call-next-method sheet (min (- gw dw) width) (min (- gh dh) height)))))
(defmethod modal-frame-p ((frame t)) nil)
(defmethod modal-frame-p ((frame clim-internals::accept-values-own-window)) t)
......
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