<commit_before>#lang racket/base
(require racket/class
         racket/draw
         (only-in racket/list last)
         ffi/unsafe
         ffi/unsafe/alloc
	 "../../syntax.rkt"
	 "../../lock.rkt"
	 "../common/queue.rkt"
	 "../common/freeze.rkt"
         "utils.rkt"
         "const.rkt"
         "types.rkt"
         "theme.rkt"
	 "window.rkt"
         "wndclass.rkt"
         "hbitmap.rkt"
         "cursor.rkt")

(provide 
 (protect-out frame%
              display-size
              display-origin))

(define-user32 SetLayeredWindowAttributes (_wfun _HWND _COLORREF _BYTE _DWORD -> _BOOL))
(define-user32 GetActiveWindow (_wfun -> _HWND))
(define-user32 SetFocus (_wfun _HWND -> _HWND))
(define-user32 BringWindowToTop (_wfun _HWND -> (r : _BOOL) -> (unless r (failed 'BringWindowToTop))))

(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int))

(define-user32 DrawMenuBar (_wfun _HWND -> (r : _BOOL)
                                  -> (unless r (failed 'DrawMenuBar))))

(define-user32 IsZoomed (_wfun _HWND -> _BOOL))

(define-user32 SystemParametersInfoW (_wfun _UINT _UINT _pointer _UINT -> (r : _BOOL)
                                            -> (unless r (failed 'SystemParametersInfo))))
(define-cstruct _MINMAXINFO ([ptReserved _POINT]
                             [ptMaxSize _POINT]
                             [ptMaxPosition _POINT]
                             [ptMinTrackSize _POINT]
                             [ptMaxTrackSize _POINT]))

(define-cstruct _ICONINFO ([fIcon _BOOL]
                           [xHotspot _DWORD]
                           [yHotspot _DWORD]
                           [hbmMask _HBITMAP]
                           [hbmColor _HBITMAP]))

(define-user32 DestroyIcon (_wfun _HICON -> (r : _BOOL)
                                  -> (unless r (failed 'DestroyIcon)))
  #:wrap (deallocator))
(define-user32 CreateIconIndirect (_wfun _ICONINFO-pointer -> (r : _HICON)
                                         -> (or r (failed 'CreateIconIndirect)))
  #:wrap (allocator DestroyIcon))

(define SPI_GETWORKAREA            #x0030)

(define (display-size xb yb ?)
  (atomically
   (let ([hdc (GetDC #f)])
     (set-box! xb (GetDeviceCaps hdc HORZRES))
     (set-box! yb (GetDeviceCaps hdc VERTRES))
     (ReleaseDC #f hdc))))

(define (display-origin xb yb avoid-bars?)
  (if avoid-bars?
      (let ([r (make-RECT 0 0 0 0)])
        (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
        (set-box! xb (RECT-left r))
        (set-box! yb (RECT-top r)))
      (begin
        (set-box! xb 0)
        (set-box! yb 0))))

(define mouse-frame #f)

(define WS_EX_TOOLWINDOW        #x00000080)
(define WS_EX_TOPMOST           #x00000008)
(define WS_EX_WINDOWEDGE        #x00000100)
(define WS_EX_PALETTEWINDOW     (bitwise-ior WS_EX_WINDOWEDGE 
                                             WS_EX_TOOLWINDOW 
                                             WS_EX_TOPMOST))

(define-cstruct _WINDOWPLACEMENT
  ([length _UINT]
   [flags _UINT]
   [showCmd _UINT]
   [ptMinPosition _POINT]
   [ptMaxPosition _POINT]
   [rcNormalPosition _RECT]))

(define-user32 GetWindowPlacement (_wfun _HWND _WINDOWPLACEMENT-pointer -> (r : _BOOL)
                                         -> (unless r (failed 'GetWindowPlacement))))

(define-user32 IsIconic (_fun _HWND -> _BOOL))

(defclass frame% window%
  (init parent
	label
	x y w h
	style)
  
  (inherit get-hwnd 
	   is-shown?
	   get-eventspace
           on-size
           pre-on-char pre-on-event
           reset-cursor-in-child)

  (define/public (create-frame parent label x y w h style)
    (CreateWindowExW (if (memq 'float style)
                         (bitwise-ior WS_EX_TOOLWINDOW
                                      (if (memq 'no-caption style)
                                          WS_EX_TOPMOST
                                          WS_EX_PALETTEWINDOW))
                         0)
                     "PLTFrame"
                     (if label label "")
                     (bitwise-ior
                      WS_POPUP
                      (if (memq 'no-resize-border style)
                          0
                          (bitwise-ior WS_THICKFRAME
                                       WS_BORDER
                                       WS_MAXIMIZEBOX))
                      (if (memq 'no-system-menu style)
                          0
                          WS_SYSMENU)
                      (if (memq 'no-caption style)
                          0
                          (bitwise-ior WS_CAPTION
                                       WS_MINIMIZEBOX)))
                     (if (= x -11111) CW_USEDEFAULT x)
                     (if (= y -11111) CW_USEDEFAULT y)
                     w h
                     #f
                     #f
                     hInstance
                     #f))

  (define saved-title (or label ""))
  (define hidden-zoomed? #f)
  (define float-without-caption? (and (memq 'float style)
                                      (memq 'no-caption style)))

  (define min-width #f)
  (define min-height #f)
  (define max-width #f)
  (define max-height #f)

  (super-new [parent #f]
	     [hwnd (create-frame parent label x y w h style)]
	     [style (cons 'deleted style)])

  (define hwnd (get-hwnd))
  (SetLayeredWindowAttributes hwnd 0 255 LWA_ALPHA)

  ;; record delta between size and client size
  ;; for getting the client size when the frame 
  ;; is iconized:
  (define-values (client-dw client-dh)
    (let ([w (box 0)] [h (box 0)]
          [cw (box 0)] [ch (box 0)])
      (get-size w h)
      (get-client-size cw ch)
      (values (- (unbox w) (unbox cw)) 
              (- (unbox h) (unbox  ch)))))

  (define/public (is-dialog?) #f)

  (define/override (show on?)
    (let ([es (get-eventspace)])
      (when (and on?
		 (eventspace-shutdown? es))
	(error (string->symbol
		(format "show method in ~a"
			(if (is-dialog?)
			    'dialog%
			    'frame%)))
	       "eventspace has been shutdown")))
    (super show on?))

  (define/override (direct-show on?)
    ;; atomic mode
    (when (eq? mouse-frame this) (set! mouse-frame #f))
    (register-frame-shown this on?)
    (when (and (not on?) (is-shown?))
      (set! hidden-zoomed? (is-maximized?)))
    (super direct-show on? (if hidden-zoomed?
                               SW_SHOWMAXIMIZED
                               (if float-without-caption?
                                   SW_SHOWNOACTIVATE
                                   SW_SHOW)))
    (when (and on? (iconized?))
      (ShowWindow hwnd SW_RESTORE))
    (when on?
      (unless float-without-caption?
        (BringWindowToTop hwnd))))

  (define/public (destroy)
    (direct-show #f))

  (define/private (stdret f d)
    (if (is-dialog?) d f))

  (define/override (wndproc w msg wParam lParam default)
    (cond
     [(= msg WM_CLOSE)
      (queue-window-event this (lambda () 
				 (when (on-close)
                                   (atomically
                                    (direct-show #f)))))
      0]
     [(and (= msg WM_SIZE)
           (not (= wParam SIZE_MINIMIZED)))
      (queue-window-event this (lambda () (on-size 0 0)))
      (stdret 0 1)]
     [(= msg WM_MOVE)
      (queue-window-event this (lambda () (on-size 0 0)))
      (stdret 0 1)]
     [(= msg WM_ACTIVATE)
      (let ([state (LOWORD wParam)]
            [minimized (HIWORD wParam)])
        (unless (not (zero? minimized))
          (let ([on? (or (= state WA_ACTIVE)<commit_msg>win32: on-size fix<commit_after>#lang racket/base
(require racket/class
         racket/draw
         (only-in racket/list last)
         ffi/unsafe
         ffi/unsafe/alloc
	 "../../syntax.rkt"
	 "../../lock.rkt"
	 "../common/queue.rkt"
	 "../common/freeze.rkt"
         "utils.rkt"
         "const.rkt"
         "types.rkt"
         "theme.rkt"
	 "window.rkt"
         "wndclass.rkt"
         "hbitmap.rkt"
         "cursor.rkt")

(provide 
 (protect-out frame%
              display-size
              display-origin))

(define-user32 SetLayeredWindowAttributes (_wfun _HWND _COLORREF _BYTE _DWORD -> _BOOL))
(define-user32 GetActiveWindow (_wfun -> _HWND))
(define-user32 SetFocus (_wfun _HWND -> _HWND))
(define-user32 BringWindowToTop (_wfun _HWND -> (r : _BOOL) -> (unless r (failed 'BringWindowToTop))))

(define-gdi32 GetDeviceCaps (_wfun _HDC _int -> _int))

(define-user32 DrawMenuBar (_wfun _HWND -> (r : _BOOL)
                                  -> (unless r (failed 'DrawMenuBar))))

(define-user32 IsZoomed (_wfun _HWND -> _BOOL))

(define-user32 SystemParametersInfoW (_wfun _UINT _UINT _pointer _UINT -> (r : _BOOL)
                                            -> (unless r (failed 'SystemParametersInfo))))
(define-cstruct _MINMAXINFO ([ptReserved _POINT]
                             [ptMaxSize _POINT]
                             [ptMaxPosition _POINT]
                             [ptMinTrackSize _POINT]
                             [ptMaxTrackSize _POINT]))

(define-cstruct _ICONINFO ([fIcon _BOOL]
                           [xHotspot _DWORD]
                           [yHotspot _DWORD]
                           [hbmMask _HBITMAP]
                           [hbmColor _HBITMAP]))

(define-user32 DestroyIcon (_wfun _HICON -> (r : _BOOL)
                                  -> (unless r (failed 'DestroyIcon)))
  #:wrap (deallocator))
(define-user32 CreateIconIndirect (_wfun _ICONINFO-pointer -> (r : _HICON)
                                         -> (or r (failed 'CreateIconIndirect)))
  #:wrap (allocator DestroyIcon))

(define SPI_GETWORKAREA            #x0030)

(define (display-size xb yb ?)
  (atomically
   (let ([hdc (GetDC #f)])
     (set-box! xb (GetDeviceCaps hdc HORZRES))
     (set-box! yb (GetDeviceCaps hdc VERTRES))
     (ReleaseDC #f hdc))))

(define (display-origin xb yb avoid-bars?)
  (if avoid-bars?
      (let ([r (make-RECT 0 0 0 0)])
        (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
        (set-box! xb (RECT-left r))
        (set-box! yb (RECT-top r)))
      (begin
        (set-box! xb 0)
        (set-box! yb 0))))

(define mouse-frame #f)

(define WS_EX_TOOLWINDOW        #x00000080)
(define WS_EX_TOPMOST           #x00000008)
(define WS_EX_WINDOWEDGE        #x00000100)
(define WS_EX_PALETTEWINDOW     (bitwise-ior WS_EX_WINDOWEDGE 
                                             WS_EX_TOOLWINDOW 
                                             WS_EX_TOPMOST))

(define-cstruct _WINDOWPLACEMENT
  ([length _UINT]
   [flags _UINT]
   [showCmd _UINT]
   [ptMinPosition _POINT]
   [ptMaxPosition _POINT]
   [rcNormalPosition _RECT]))

(define-user32 GetWindowPlacement (_wfun _HWND _WINDOWPLACEMENT-pointer -> (r : _BOOL)
                                         -> (unless r (failed 'GetWindowPlacement))))

(define-user32 IsIconic (_fun _HWND -> _BOOL))

(defclass frame% window%
  (init parent
	label
	x y w h
	style)
  
  (inherit get-hwnd 
	   is-shown?
	   get-eventspace
           queue-on-size
           pre-on-char pre-on-event
           reset-cursor-in-child)

  (define/public (create-frame parent label x y w h style)
    (CreateWindowExW (if (memq 'float style)
                         (bitwise-ior WS_EX_TOOLWINDOW
                                      (if (memq 'no-caption style)
                                          WS_EX_TOPMOST
                                          WS_EX_PALETTEWINDOW))
                         0)
                     "PLTFrame"
                     (if label label "")
                     (bitwise-ior
                      WS_POPUP
                      (if (memq 'no-resize-border style)
                          0
                          (bitwise-ior WS_THICKFRAME
                                       WS_BORDER
                                       WS_MAXIMIZEBOX))
                      (if (memq 'no-system-menu style)
                          0
                          WS_SYSMENU)
                      (if (memq 'no-caption style)
                          0
                          (bitwise-ior WS_CAPTION
                                       WS_MINIMIZEBOX)))
                     (if (= x -11111) CW_USEDEFAULT x)
                     (if (= y -11111) CW_USEDEFAULT y)
                     w h
                     #f
                     #f
                     hInstance
                     #f))

  (define saved-title (or label ""))
  (define hidden-zoomed? #f)
  (define float-without-caption? (and (memq 'float style)
                                      (memq 'no-caption style)))

  (define min-width #f)
  (define min-height #f)
  (define max-width #f)
  (define max-height #f)

  (super-new [parent #f]
	     [hwnd (create-frame parent label x y w h style)]
	     [style (cons 'deleted style)])

  (define hwnd (get-hwnd))
  (SetLayeredWindowAttributes hwnd 0 255 LWA_ALPHA)

  ;; record delta between size and client size
  ;; for getting the client size when the frame 
  ;; is iconized:
  (define-values (client-dw client-dh)
    (let ([w (box 0)] [h (box 0)]
          [cw (box 0)] [ch (box 0)])
      (get-size w h)
      (get-client-size cw ch)
      (values (- (unbox w) (unbox cw)) 
              (- (unbox h) (unbox  ch)))))

  (define/public (is-dialog?) #f)

  (define/override (show on?)
    (let ([es (get-eventspace)])
      (when (and on?
		 (eventspace-shutdown? es))
	(error (string->symbol
		(format "show method in ~a"
			(if (is-dialog?)
			    'dialog%
			    'frame%)))
	       "eventspace has been shutdown")))
    (super show on?))

  (define/override (direct-show on?)
    ;; atomic mode
    (when (eq? mouse-frame this) (set! mouse-frame #f))
    (register-frame-shown this on?)
    (when (and (not on?) (is-shown?))
      (set! hidden-zoomed? (is-maximized?)))
    (super direct-show on? (if hidden-zoomed?
                               SW_SHOWMAXIMIZED
                               (if float-without-caption?
                                   SW_SHOWNOACTIVATE
                                   SW_SHOW)))
    (when (and on? (iconized?))
      (ShowWindow hwnd SW_RESTORE))
    (when on?
      (unless float-without-caption?
        (BringWindowToTop hwnd))))

  (define/public (destroy)
    (direct-show #f))

  (define/private (stdret f d)
    (if (is-dialog?) d f))

  (define/override (wndproc w msg wParam lParam default)
    (cond
     [(= msg WM_CLOSE)
      (queue-window-event this (lambda () 
				 (when (on-close)
                                   (atomically
                                    (direct-show #f)))))
      0]
     [(and (= msg WM_SIZE)
           (not (= wParam SIZE_MINIMIZED)))
      (queue-window-event this (lambda () (queue-on-size)))
      (stdret 0 1)]
     [(= msg WM_MOVE)
      (queue-window-event this (lambda () (queue-on-size)))
      (stdret 0 1)]
     [(= msg WM_ACTIVATE)
      (let ([state (LOWORD wParam)]
            [minimized (HIWORD wParam)])
        (unless (not (zero? minimized))
          (let ([on? (or (= state WA_ACTIVE)
{'fraction_non_alphanumeric': 0.1144372105510437, 'fraction_numerical': 0.012081347741459159, 'mean_word_length': 1.5012590229981535, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 41, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 2, 'word_list_counts': {'cursed_substrings.json': 54, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6257862', 'n_tokens_mistral': 4970, 'n_tokens_neox': 4585, 'n_words': 1165}