Skip to content
Snippets Groups Projects
Commit dd618ea5 authored by Kevin Layer's avatar Kevin Layer
Browse files

resolve conflicts in merge

parents 979ba695 73027422
No related branches found
No related tags found
No related merge requests found
...@@ -3,6 +3,11 @@ ...@@ -3,6 +3,11 @@
don't forget to change the version in utils/packages.lisp if you do anything don't forget to change the version in utils/packages.lisp if you do anything
user visible. 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> 2009-09-10 Andreas Fuchs <afuchs@franz.com>
* tk/font.lisp: Fix (obvious, in retrospect) printer error in warning about missing * tk/font.lisp: Fix (obvious, in retrospect) printer error in warning about missing
......
...@@ -36,38 +36,49 @@ ...@@ -36,38 +36,49 @@
;;--- This isn't really right, all ports only have kludges for this ;;--- This isn't really right, all ports only have kludges for this
(defmethod sheet-shell (sheet) sheet) (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) (defmethod realize-graft ((port acl-port) graft)
(let ((screen (slot-value (screen-device *acl-port*) 'device-handle1))) (let ((screen (slot-value (screen-device *acl-port*) 'device-handle1)))
(setf (port-screen port) screen) (setf (port-screen port) screen)
(init-cursors) (init-cursors)
(with-slots (silica::pixels-per-point (with-slots (silica::pixels-per-point
silica::pixel-width silica::pixel-width
silica::pixel-height silica::pixel-height
silica::mm-width silica::mm-width
silica::mm-height silica::mm-height
silica::units) graft silica::units) graft
(with-dc (screen dc) (with-dc (screen dc)
(let ((screen-width (win:GetSystemMetrics win:SM_CXSCREEN)) (multiple-value-bind (screen-left screen-top screen-right screen-bottom)
(screen-height (win:GetSystemMetrics win:SM_CYSCREEN)) (win-full-screen-area)
(logpixelsx (win:GetDeviceCaps dc win:LOGPIXELSX)) (let ((screen-width (- screen-left screen-right))
(logpixelsy (win:GetDeviceCaps dc win:LOGPIXELSY))) (screen-height (- screen-bottom screen-top))
(setf silica::pixel-width screen-width (logpixelsx (win:GetDeviceCaps dc win:LOGPIXELSX))
silica::pixel-height screen-height (logpixelsy (win:GetDeviceCaps dc win:LOGPIXELSY)))
silica::mm-width (round (* screen-width 25.4s0) logpixelsx) (setf silica::pixel-width (- screen-left screen-right)
silica::mm-height (round (* screen-height 25.4s0) logpixelsy)) silica::pixel-height (- screen-bottom screen-top)
(let* ((ppp (/ logpixelsy 72s0)) silica::mm-width (round (* screen-width 25.4s0) logpixelsx)
(rounded-ppp (round ppp))) silica::mm-height (round (* screen-height 25.4s0) logpixelsy))
(setf silica::pixels-per-point (let* ((ppp (/ logpixelsy 72s0))
(if (< (abs (- ppp rounded-ppp)) .1s0) rounded-ppp ppp))) (rounded-ppp (round ppp)))
(setf (sheet-region graft) (setf silica::pixels-per-point
(ecase silica::units (if (< (abs (- ppp rounded-ppp)) .1s0) rounded-ppp ppp)))
((:device :pixel)
(make-bounding-rectangle (setf (sheet-region graft)
0 0 (ecase silica::units
silica::pixel-width silica::pixel-height)))) ((:device :pixel)
(setf (sheet-native-transformation graft) +identity-transformation+) (make-bounding-rectangle
(setf (sheet-direct-mirror graft) screen) screen-left screen-top screen-right screen-bottom))))
(update-mirror-transformation port graft)))))) (setf (sheet-native-transformation graft) +identity-transformation+)
(setf (sheet-direct-mirror graft) screen)
(update-mirror-transformation port graft)))))))
(defmethod modal-frame-p ((frame t)) nil) (defmethod modal-frame-p ((frame t)) nil)
(defmethod modal-frame-p ((frame clim-internals::accept-values-own-window)) t) (defmethod modal-frame-p ((frame clim-internals::accept-values-own-window)) t)
...@@ -535,4 +546,15 @@ ...@@ -535,4 +546,15 @@
((member :maximized new-flags) ((member :maximized new-flags)
(win:ShowWindow mirror win:SW_MAXIMIZE)) (win:ShowWindow mirror win:SW_MAXIMIZE))
((member :minimized new-flags) ((member :minimized new-flags)
(win:ShowWindow mirror win:SW_MINIMIZE))))) (win:ShowWindow mirror win:SW_MINIMIZE)))))
\ No newline at end of file
(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)))))
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