Changeset 14264


Ignore:
Timestamp:
Sep 16, 2010, 3:12:58 PM (9 years ago)
Author:
gb
Message:

Preliminary support for (hopefully reasonable) MAKE-INSTANCE of NS-WINDOW
and NS-VIEW.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-window.lisp

    r12829 r14264  
    341341                        #@"") ))
    342342
    343 (defun new-cocoa-window (&key
     343(defmethod allocate-instance ((class ns:+ns-window)
     344                              &rest initargs
     345                              &key
     346                              (with-content-rect nil content-rect-p)
     347                              (style-mask 0 style-mask-p)
     348                              (x 200)
     349                              (y 200)
     350                              (width 500)
     351                              (height 200)
     352                              (closable t)
     353                              (iconifyable t)
     354                              (expandable t)
     355                              (metal nil)
     356                              (backing :buffered)
     357                              (defer t defer-p)
     358                              &allow-other-keys)
     359  (declare (ignore defer with-content-rect))
     360  (unless content-rect-p
     361    (setq initargs (cons :with-content-rect
     362                         (cons (ns:make-ns-rect x y width height)
     363                               initargs))))
     364  (unless (and style-mask-p (typep style-mask 'fixnum))
     365    (setq initargs (cons :style-mask
     366                         (cons (logior #$NSTitledWindowMask
     367                                       (if closable #$NSClosableWindowMask 0)
     368                                       (if iconifyable #$NSMiniaturizableWindowMask 0)
     369                                       (if expandable #$NSResizableWindowMask 0)
     370                                       (if metal #$NSTexturedBackgroundWindowMask 0))
     371                               initargs))))
     372  (unless (typep (getf initargs :backing) 'fixnum)
     373    (setq initargs
     374          (cons :backing
     375                (cons (ecase backing
     376                        ((t :retained) #$NSBackingStoreRetained)
     377                        ((nil :nonretained) #$NSBackingStoreNonretained)
     378                        (:buffered #$NSBackingStoreBuffered))
     379                      initargs))))
     380  (unless defer-p
     381    (setq initargs (cons :defer (cons t initargs))))
     382  (apply #'call-next-method class initargs))
     383
     384(defmethod initialize-instance :after ((w ns:ns-window)
     385                                       &key
     386                                       (title nil)
     387                                       (x 200.0)
     388                                       (y 200.0)
     389                                       (height 200.0)
     390                                       (width 500.0)
     391                                       (closable t)
     392                                       (iconifyable t)
     393                                       (metal nil)
     394                                       (expandable t)
     395                                       (backing :buffered)
     396                                       (defer t)
     397                                       (accepts-mouse-moved-events nil)
     398                                       (auto-display t)
     399                                       (activate nil)
     400                                       &allow-other-keys)
     401  ;; Several of the keyword args we claim to accept are actually processed
     402  ;; by the ALLOCATE-INSTANCE method above and are ignored here.
     403  (declare (ignore x y width height closable iconifyable expandable metal
     404                   backing defer))
     405  (setf (get-cocoa-window-flag w :accepts-mouse-moved-events)
     406        accepts-mouse-moved-events
     407        (get-cocoa-window-flag w :auto-display)
     408        auto-display)
     409  ;;; Should maybe have a way of controlling this.
     410  (#/setBackgroundColor: w (#/whiteColor ns:ns-color))
     411  (when title
     412    (set-window-title w title))
     413  (when activate
     414    (activate-window w)))
     415
     416
     417(defmethod allocate-instance ((class ns:+ns-view)
     418                              &rest initargs
     419                              &key
     420                              (with-frame nil with-frame-p)
     421                              (x 0)
     422                              (y 0)
     423                              (width 0)
     424                              (height 0)
     425                              &allow-other-keys)
     426  (unless with-frame-p
     427    (setq initargs (cons :with-frame
     428                         (cons (ns:make-ns-rect x y width height) initargs))))
     429  (apply #'call-next-method class initargs))
     430
     431
     432(defmethod initialize-instance :after ((view ns:ns-view)
     433                                       &key
     434                                       (horizontally-resizable nil hrp)
     435                                       (vertically-resizable nil vrp)
     436                                       (max-x-margin nil maxxp)
     437                                       (min-x-margin nil minxp)
     438                                       (max-y-margin nil maxyp)
     439                                       (min-y-margin nil minyp)
     440                                       (resizes-subviews t rsp)
     441                                       &allow-other-keys)
     442  (let* ((mask (#/autoresizingMask view))
     443         (newmask mask))
     444    (when hrp
     445      (setq newmask (if horizontally-resizable
     446                      (logior newmask #$NSViewWidthSizable)
     447                      (logandc2 newmask #$NSViewWidthSizable))))
     448    (when vrp
     449      (setq newmask (if vertically-resizable
     450                      (logior newmask #$NSViewHeightSizable)
     451                      (logandc2 newmask #$NSViewHeightSizable))))
     452    (when minxp
     453      (setq newmask (if min-x-margin
     454                      (logior newmask #$NSViewMinXMargin)
     455                      (logandc2 newmask #$NSViewMinXMargin))))
     456    (when maxxp
     457      (setq newmask (if max-x-margin
     458                      (logior newmask #$NSViewMaxXMargin)
     459                      (logandc2 newmask #$NSViewMaxXMargin))))
     460    (when minyp
     461      (setq newmask (if min-y-margin
     462                      (logior newmask #$NSViewMinYMargin)
     463                      (logandc2 newmask #$NSViewMinYMargin))))
     464    (when maxyp
     465      (setq newmask (if max-y-margin
     466                      (logior newmask #$NSViewMaxYMargin)
     467                      (logandc2 newmask #$NSViewMaxYMargin))))
     468    (unless (eql mask newmask)
     469      (#/setAutoresizingMask: view newmask)))
     470  (when rsp
     471    (#/setAutoresizesSubviews: view resizes-subviews)))
     472                             
     473
     474(defun new-cocoa-window (&rest
     475                         initargs
     476                         &key
    344477                         (class (find-class 'ns:ns-window))
    345478                         (title nil)
     
    357490                         (auto-display t)
    358491                         (activate t))
    359   (ns:with-ns-rect (frame x y width height)
    360     (let* ((stylemask
    361             (logior #$NSTitledWindowMask
    362                     (if closable #$NSClosableWindowMask 0)
    363                     (if iconifyable #$NSMiniaturizableWindowMask 0)
    364                     (if expandable #$NSResizableWindowMask 0)
    365                     (if metal #$NSTexturedBackgroundWindowMask 0)))
    366            (backing-type
    367             (ecase backing
    368               ((t :retained) #$NSBackingStoreRetained)
    369               ((nil :nonretained) #$NSBackingStoreNonretained)
    370               (:buffered #$NSBackingStoreBuffered)))
    371            (w (make-instance
    372                class
    373                :with-content-rect frame
    374                :style-mask stylemask
    375                :backing backing-type
    376                :defer defer)))
    377       (setf (get-cocoa-window-flag w :accepts-mouse-moved-events)
    378             accepts-mouse-moved-events
    379             (get-cocoa-window-flag w :auto-display)
    380             auto-display)
    381       (#/setBackgroundColor: w (#/whiteColor ns:ns-color))
    382       (when activate (activate-window w))
    383       (when title (set-window-title w title))
     492  (declare (ignore title x y width height closable iconifyable metal
     493                   expandable backing defer accepts-mouse-moved-events
     494                   auto-display activate))
     495  (apply #'make-instance class initargs))
     496
     497(defmethod view-window ((view ns:ns-view))
     498  (let* ((w (#/window view)))
     499    (unless (%null-ptr-p w)
    384500      w)))
    385 
    386 
    387 
    388 
Note: See TracChangeset for help on using the changeset viewer.