Changeset 14264
- Timestamp:
- Sep 16, 2010, 3:12:58 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/cocoa-ide/cocoa-window.lisp
r12829 r14264 341 341 #@"") )) 342 342 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 344 477 (class (find-class 'ns:ns-window)) 345 478 (title nil) … … 357 490 (auto-display t) 358 491 (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) 384 500 w))) 385 386 387 388
Note: See TracChangeset
for help on using the changeset viewer.