Lisp HUG Maillist Archive

capi:top-level-interface-geometry

I use capi:top-level-interface-geometry to save the position and size
of windows to an init file for my application. In some very rare cases
(only under Windows), it will return 0 for width and height instead of
the real values.

I have to admit that I run this function outside of the interfaces
process, since another process is gathering information about all the
windows. May that be the source of the bad values? If you think I need
to run this with execute-with-interface, then I guess I'll have to
come up with some kludgy workaround, but I'd like to know that it's
absolutely necessary before I do so.

Anyway, I'm not able to reproduce this myself, I've run tests that
collects the sizes of several windows 100 million times without coming
up with a single zero value. In the strange world of Windows, I've
seen examples that /graphic cards drivers/ interfere with things like
this, so I wouldn't be suprised if the error is limited to very
specific system configurations.

Thanks in advance for any suggestions!
-- 
  (espen)


AW: capi:top-level-interface-geometry



> -----Ursprüngliche Nachricht-----
> Von: owner-lisp-hug@lispworks.com 
> [mailto:owner-lisp-hug@lispworks.com] Im Auftrag von Espen Vestre
> Gesendet: Donnerstag, 2. August 2007 17:32
> An: lisp-hug@lispworks.com
> Betreff: capi:top-level-interface-geometry
> 
> 
> 
> I use capi:top-level-interface-geometry to save the position 
> and size of windows to an init file for my application. In 
> some very rare cases (only under Windows), it will return 0 
> for width and height instead of the real values.
> 
> I have to admit that I run this function outside of the 
> interfaces process, since another process is gathering 
> information about all the windows. May that be the source of 
> the bad values? If you think I need to run this with 
> execute-with-interface, then I guess I'll have to come up 
> with some kludgy workaround, but I'd like to know that it's 
> absolutely necessary before I do so.
> 
> Anyway, I'm not able to reproduce this myself, I've run tests 
> that collects the sizes of several windows 100 million times 
> without coming up with a single zero value. In the strange 
> world of Windows, I've seen examples that /graphic cards 
> drivers/ interfere with things like this, so I wouldn't be 
> suprised if the error is limited to very specific system 
> configurations.
> 
> Thanks in advance for any suggestions!
> -- 
>   (espen)
> 

Hi Espen,

Well I don't know the correct answer. In my app I use it within destroy-callback of the main programm interface (window).

The docu's example at CAPI Reference Manual/1 CAPI Reference Entries/top-level-interface-geometry is not executed within the
interface's process, thus I guess it is not required.

Functions required to run within an pane process often cause some error if invoked from another process.

The esample for your convenience with my additional comments:

;; Define and display an interface.
(capi:define-interface test ()
  ()
  (:panes (panel capi:list-panel)))

;; Andreas: Create interface window in it's own process
(setq int (capi:display (make-instance 'test)))

;; Now manually position the interface somewhere.

;; Find where the interface is.
;; Andreas: Executed in the listener or main program process
(multiple-value-setq (tx ty twidth theight)
    (capi:top-level-interface-geometry int))

;; Now manually close the interface.
;; Create a new interface in the same place.
(setq int
      (capi:display
       (make-instance
        'test
        :best-x tx
        :best-y ty
        :best-width twidth
        :best-height theight)))

Andreas


Re: AW: capi:top-level-interface-geometry

There are also some issues with multiple monitors.  I have found I have to check, say, if the monitor geometry
has moved, or a display is completely gone.

Here is some code...  In general the interface geometry is stored when the destroy-callback is invoked
and it restored with my force-display function.  (winapi:monitor-from-point follows).

Wade


(defun force-display (interface &rest keys &key best-x best-y &allow-other-keys)
  (let* ((display (apply #'capi:display interface :allow-other-keys t keys)))
    (multiple-value-bind (actual-x actual-y)
        (capi:top-level-interface-geometry display)
      (unless best-x (setf best-x actual-x))
      (unless best-y (setf best-y actual-y))
      (when (and (winapi::monitor-from-point best-x best-y)
                 (or (/= best-x actual-x)
                     (/= best-y actual-y)))
        (capi:set-top-level-interface-geometry display :x best-x :y best-y))
      display)))

(capi:define-interface run-report-interface ()
  ((running-log-interface :initarg :running-log-interface :accessor running-log-interface)
   (report-last-selected-date :initform nil)
   (report-start-date :initform nil)
   (report-end-date :initform nil))
  (:panes
   (report-annotation capi::text-input-pane
                        :title "Annotation"
                        :title-position :left
                        :font *report-entry-font*
                        :background :white)

   (report-type-choice capi:list-panel
                       :items '(|Diary Report|
                                |Weekly Distance Report|
                                |Schedule Report|
                                |Race Report|)
                       :font *report-entry-font*
                       :visible-min-width 150
                       :visible-max-height 75)

   (report-interval-type capi:radio-button-panel
                         :items '(|Current Year|
                                  |Current Month|
                                  |Selected Dates|)
                         :layout-class 'capi:column-layout
                         :font *report-entry-font*
                         :selection-callback
                         (lambda (interval log)
                           (with-slots (report-start-pane report-end-pane) log
                             (case interval
                               (|Selected Dates|
                                (setf (capi:simple-pane-background report-start-pane) :white
                                      (capi:simple-pane-background report-end-pane) :white
                                      (capi:simple-pane-foreground report-start-pane) :black
                                      (capi:simple-pane-foreground report-end-pane) :black
                                      (capi:simple-pane-enabled report-start-pane) t
                                      (capi:simple-pane-enabled report-end-pane) t))
                               (otherwise
                                (setf (capi:simple-pane-background report-start-pane) :lightgrey
                                      (capi:simple-pane-background report-end-pane) :lightgrey
                                      (capi:simple-pane-foreground report-start-pane) :grey
                                      (capi:simple-pane-foreground report-end-pane) :grey
                                      (capi:simple-pane-enabled report-start-pane) nil
                                      (capi:simple-pane-enabled report-end-pane) nil))))))

   (report-start-pane capi:title-pane
                      :enabled nil
                      :visible-min-width 100
                      :font *report-entry-font*
                      :background :lightgrey
                      :foreground :grey)

   (report-end-pane capi:title-pane
                    :enabled nil
                    :visible-min-width 100
                    :font *report-entry-font*
                    :background :lightgrey
                    :foreground :grey)

   (report-start-set-current-button capi:push-button
                           :text "<< Current Date"
                           :font *small-font*
                           :callback-type :interface
                           :callback (lambda (log) (set-report-start-current (running-log-interface log))))

   (report-end-set-current-button capi:push-button
                           :text "<< Current Date"
                           :font *small-font*
                           :callback-type :interface
                           :callback (lambda (log) (set-report-end-current (running-log-interface log))))

   (report-in-browser-panel capi:radio-button-panel
                            :items '(t nil)
                            :font *report-entry-font*
                            :print-function (lambda (item)
                                              (if item "Yes" "No"))
                            :layout-class 'capi:row-layout
                            :title "View Report After Generation"
                            :title-position :left)
   (generate-report-button capi:push-button
                           :text "Generate Report"
                           :font *display-font*
                           :max-width :screen-width
                           :callback-type :interface
                           :callback 'generate-report))

  (:layouts
   (report-dialog capi:column-layout
                  '(report-row-1
                    report-grid
                    report-in-browser-panel
                    report-annotation
                    generate-report-button)
                  :y-gap 5)

   (report-row-1 capi:row-layout
                 '(report-type-choice report-interval-type)
                 :x-gap 10)

   (report-grid capi:grid-layout
                '("Start Date:"
                  report-start-pane
                  report-start-set-current-button
                  "End Date:"
                  report-end-pane
                  report-end-set-current-button)
                :rows 1 :columns 6
                :x-adjust '(:right :center :center :right :center :center)
                :y-adjust :center))

  (:default-initargs
   :auto-menus nil
   :destroy-callback (lambda (run-report)
                       (setf (getf (runner-plist (runner (running-log-interface run-report))) :report-interface-geometry)
                             (multiple-value-bind (best-x best-y)
                                 (capi:top-level-interface-geometry run-report)
                               (list :best-x best-x :best-y best-y)))
                       (setf (run-report-interface (running-log-interface run-report)) nil))))
   

(defun show-report-tool (log)
  (if (run-report-interface log)
      (capi:show-interface (run-report-interface log))
    (destructuring-bind (&key (best-x nil) (best-y nil))
        (getf (runner-plist (runner log)) :report-interface-geometry)
      (setf (run-report-interface log)
            (force-display (make-instance 'run-report-interface :running-log-interface log
                                         :best-x best-x
                                         :best-y best-y
                                         :title (format nil "Running Log Report Tool for ~A" (runner-name (runner log))))
                           :best-x best-x
                           :best-y best-y
                           :owner log)))))

(in-package :winapi)

(defconstant MONITOR_DEFAULTTONULL 0)
(defconstant MONITOR_DEFAULTTOPRIMARY 1)
(defconstant MONITOR_DEFAULTTONEAREST 2)
(defconstant MONITORINFOF_PRIMARY 1)

(fli:define-c-struct MONITORINFO
  (cbsize dword)
  (rcmonitor rect)
  (rcwork rect)
  (dwflags dword))
(fli::define-precompiled-foreign-object-accessor-functions (((:struct monitorinfo) :no-alloc-p t :size t)))

(defstruct monitor
  display-area
  work-area
  primary-p)

(defun monitorinfo-to-monitor (monitorinfo)
  (let ((display-area-rect (fli:foreign-slot-value monitorinfo 'rcmonitor :copy-foreign-object nil))
        (work-area-rect (fli:foreign-slot-value monitorinfo 'rcwork :copy-foreign-object nil)))
    (make-monitor :display-area
                  (list
                   (fli:foreign-slot-value display-area-rect 'left)
                   (fli:foreign-slot-value display-area-rect 'top)
                   (fli:foreign-slot-value display-area-rect 'right)
                   (fli:foreign-slot-value display-area-rect 'bottom))
                  :work-area
                  (list
                   (fli:foreign-slot-value work-area-rect 'left)
                   (fli:foreign-slot-value work-area-rect 'top)
                   (fli:foreign-slot-value work-area-rect 'right)
                   (fli:foreign-slot-value work-area-rect 'bottom))
                  :primary-p
                  (= (fli:foreign-slot-value monitorinfo 'dwflags) MONITORINFOF_PRIMARY))))
                                                
 

(winapi-function |MonitorFromPoint|
                 ((pt point)
                  (dwFlags dword))
                 handle
                 :module "user32")

(winapi-function |GetMonitorInfoW|
                 ((hmonitor handle)
                  (lpmi (:pointer monitorinfo)))
                 :boolean
                 :module "user32")

(defun monitor-from-point (x y &optional (default-return nil))
  (fli:with-dynamic-foreign-objects ()
    (let ((point (fli:allocate-dynamic-foreign-object :type 'point)))
      (setf (fli:foreign-slot-value point 'x) x)
      (setf (fli:foreign-slot-value point 'y) y)
      (let ((handle (|MonitorFromPoint| (fli:dereference point :copy-foreign-object nil)
                                        (ecase default-return
                                          (:nearest MONITOR_DEFAULTTONEAREST)
                                          (:primary MONITOR_DEFAULTTOPRIMARY)
                                          ((nil) MONITOR_DEFAULTTONULL)))))
        (if (zerop handle)
            nil
          (let ((monitorinfo (fli:allocate-dynamic-foreign-object :type 'monitorinfo)))
            (setf (fli:foreign-slot-value monitorinfo 'cbsize)
                  (fli:size-of 'monitorinfo))
            (|GetMonitorInfoW| handle monitorinfo)
            (monitorinfo-to-monitor monitorinfo)))))))

Re: AW: capi:top-level-interface-geometry

"Andreas Thiele" <andreas@atp-media.de> writes:

> The docu's example at CAPI Reference Manual/1 CAPI Reference
> Entries/top-level-interface-geometry is not executed within the
> interface's process, thus I guess it is not required.

Thanks!

Yes, I've seen that. On the other hand, I just remembered that
LispWorks support gave me a somewhat vague answer on this matter
some years ago - in general it is possible that capi functions
are not thread safe even if they just call "readers" on window
system objects.
-- 
  (espen)


Re: AW: capi:top-level-interface-geometry

Wade Humeniuk <whumeniu@telus.net> writes:

> There are also some issues with multiple monitors.  I have found I  
> have to check, say, if the monitor geometry
> has moved, or a display is completely gone.

Thanks!

Yes, and there are some really nasty problems with some graphic card
drivers that try to remember the position and size of your windows -
they seem to override the default windows api in a way that makes the
top-level-interface-geometry and/or the :best-x/:best-y arguments
completely bogus.

(A window system enhancement is allowed to be part of a graphics card
 driver? Welcome to the weird, weird world of Windows. Ugh.)
-- 
  (espen)


Updated at: 2020-12-10 08:45 UTC