Changeset 7802


Ignore:
Timestamp:
Dec 2, 2007, 10:26:17 AM (13 years ago)
Author:
gb
Message:

Import from trunk.

Location:
branches/working-0711/ccl/examples/cocoa/easygui
Files:
2 added
4 edited
2 moved

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/examples/cocoa/easygui/easygui.asd

    r7499 r7802  
    2222
    2323(defsystem easygui
    24     :depends-on (cocoa.asd)
    25     :components ((:file "package")
    26                  (:file "new-cocoa-bindings" :depends-on ("package"))
    27                  (:file "events" :depends-on ("new-cocoa-bindings"))
    28                  (:file "views" :depends-on ("events"))
    29                  (:file "action-targets" :depends-on ("views"))
    30                  ;;; example:
    31                  (:file "tiny" :depends-on ("action-targets"))
    32                  (:file "currency-converter" :depends-on ("action-targets"))))
     24  :depends-on (cocoa.asd)
     25  :components ((:file "package")
     26               (:file "new-cocoa-bindings" :depends-on ("package"))
     27               (:file "events" :depends-on ("new-cocoa-bindings"))
     28               (:file "views" :depends-on ("events"))
     29               (:file "action-targets" :depends-on ("views"))
     30               (:module "example"
     31                        :depends-on ("action-targets")
     32                        :components
     33                        ((:file "tiny")
     34                         (:file "currency-converter")
     35                         (:file "view-hierarchy")))))
  • branches/working-0711/ccl/examples/cocoa/easygui/new-cocoa-bindings.lisp

    r7499 r7802  
    5050             (ns:ns-rect-width r) (ns:ns-rect-height r)))
    5151
    52 ;;;
     52;;; Base class for all Cocoa-based Easygui objects:
    5353(defclass easy-cocoa-object ()
    54      ((ref :initarg :cocoa-ref :accessor cocoa-ref)))
     54     ((ref :initarg :cocoa-ref)
     55      (ref-valid-p :initform t :accessor cocoa-ref-valid-p)))
     56
     57(defgeneric cocoa-ref (eg-object)
     58  (:method ((eg-object easy-cocoa-object))
     59     (if (cocoa-ref-valid-p eg-object)
     60         (slot-value eg-object 'ref)
     61         (error "Attempting to access an invalidated Cocoa object on ~A!"
     62                eg-object))))
     63 
     64(defgeneric (setf cocoa-ref) (new eg-object)
     65  (:method (new (eg-object easy-cocoa-object))
     66     (setf (cocoa-ref-valid-p eg-object) t
     67           (slot-value eg-object 'ref) new)))
    5568
    5669(defvar *window-position-default-x* 200)
     
    8194(defun key-mask (keyword)
    8295  (or (cdr (assoc keyword *key-to-mask-alist*)) 0))
     96
     97;;; Memory management helpers:
     98
     99(defmacro maybe-invalidating-object ((eg-object) &body body)
     100  `(if (= 1 (#/retainCount (cocoa-ref ,eg-object)))
     101       (multiple-value-prog1 (progn ,@body)
     102                             (setf (cocoa-ref-valid-p ,eg-object) nil))
     103       (progn ,@body)))
     104
     105(defmethod retain-object ((o easy-cocoa-object))
     106  (#/retain (cocoa-ref o)))
     107
     108(defmethod release-object ((o easy-cocoa-object))
     109  (#/release (cocoa-ref o)))
     110
     111(defmacro retaining-objects ((&rest eg-objects) &body body)
     112  "Retains EG-OBJECTS, runs BODY forms and releases them after control
     113has left BODY."
     114  (let ((objects (gensym)))
     115    `(let ((,objects (list ,@eg-objects)))
     116       (mapc #'retain-object ,objects)
     117       (unwind-protect (progn ,@body)
     118         (mapc #'release-object ,objects)))))
    83119
    84120;;; debug macro for #/ funcalls:
  • branches/working-0711/ccl/examples/cocoa/easygui/package.lisp

    r7529 r7802  
    55           #:point-x #:point-y #:rectangle-x #:rectangle-y #:rectangle-width
    66           #:rectangle-height
     7           ;; cocoa stuff
     8           #:retain-object #:release-object #:retaining-objects
    79           ;; view classes
    810           #:view #:static-text-view #:text-input-view #:password-input-view
     
    1315           ;; operators
    1416           #:cocoa-ref
    15            #:add-subviews #:window-show #:set-window-title
     17           #:add-subviews #:remove-subviews #:window-show #:set-window-title
    1618           #:content-view
    1719           #:initialize-view #:action #:view-text
    1820           #:add-entry #:add-entries #:editable-p
    1921           #:draw-view-rectangle
    20            #:entry-text #:nth-cell #:selection #:redisplay
     22           #:entry-text #:cell-count #:nth-cell #:selection #:redisplay
    2123           #:string-value-of #:integer-value-of #:float-value-of
    2224           #:double-value-of))
  • branches/working-0711/ccl/examples/cocoa/easygui/views.lisp

    r7529 r7802  
    1111  (:documentation "Adds a subview to another view in the view hierarchy."))
    1212
     13(defgeneric remove-1-subview (view super-view)
     14  (:documentation "Removes a view from its superview, possibly deallocating it.
     15To avoid deallocation, use RETAINING-OBJECTS"))
    1316
    1417;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    147150     ())
    148151
    149 (defclass box-view (content-view-mixin view) ())
     152(defclass box-view (content-view-mixin view-text-via-title-mixin view) ())
    150153
    151154(defclass drawing-view (view)
     
    306309  superview)
    307310
     311(defmethod remove-1-subview ((view view) (cw-view content-view-mixin))
     312  (remove-1-subview view (content-view cw-view)))
     313
     314(defmethod remove-1-subview ((view view) (super-view view))
     315  (assert (eql (cocoa-ref super-view) (#/superview (cocoa-ref view))))
     316  (maybe-invalidating-object (view)
     317    (#/removeFromSuperview (cocoa-ref view))))
     318
     319(defun remove-subviews (superview subview &rest subviews)
     320  (remove-1-subview subview superview)
     321  (dolist (subview subviews)
     322    (remove-1-subview subview superview))
     323  superview)
     324
    308325(defmethod window-show ((window window))
    309326  (dcc (#/makeKeyAndOrderFront: (cocoa-ref window) nil))
     
    323340                                    (slot-value view 'autosize-cells-p)))))
    324341
     342(defmethod cell-count ((view form-view))
     343  (dcc (#/numberOfRows (cocoa-ref view))))
     344
    325345(defmethod nth-cell (index view)
     346  (assert (< index (cell-count view)))
    326347  (let ((cocoa-cell (dcc (#/cellAtIndex: (cocoa-ref view) index))))
    327348    (when cocoa-cell
Note: See TracChangeset for help on using the changeset viewer.