Changeset 7802 for branches

Timestamp:

Dec 2, 2007, 2:26:17 AM (17 years ago)

Author:

Gary Byers

Message:

Import from trunk.

Location:

branches/working-0711/ccl/examples/cocoa/easygui

Files:

• easygui.asd (modified) (1 diff)
• example (added)
• example/currency-converter.lisp (moved) (moved from branches/working-0711/ccl/examples/cocoa/easygui/currency-converter.lisp )
• example/tiny.lisp (moved) (moved from branches/working-0711/ccl/examples/cocoa/easygui/tiny.lisp )
• example/view-hierarchy.lisp (added)
• new-cocoa-bindings.lisp (modified) (2 diffs)
• package.lisp (modified) (2 diffs)
• views.lisp (modified) (4 diffs)

branches/working-0711/ccl/examples/cocoa/easygui/easygui.asd

@@ -22 +22 @@
 
 (defsystem easygui
-    :depends-on (cocoa.asd)
-    :components ((:file "package")
-                 (:file "new-cocoa-bindings" :depends-on ("package"))
-                 (:file "events" :depends-on ("new-cocoa-bindings"))
-                 (:file "views" :depends-on ("events"))
-                 (:file "action-targets" :depends-on ("views"))
-                 ;;; example:
-                 (:file "tiny" :depends-on ("action-targets"))
-                 (:file "currency-converter" :depends-on ("action-targets"))))
+  :depends-on (cocoa.asd)
+  :components ((:file "package")
+               (:file "new-cocoa-bindings" :depends-on ("package"))
+               (:file "events" :depends-on ("new-cocoa-bindings"))
+               (:file "views" :depends-on ("events"))
+               (:file "action-targets" :depends-on ("views"))
+               (:module "example"
+                        :depends-on ("action-targets")
+                        :components
+                        ((:file "tiny")
+                         (:file "currency-converter")
+                         (:file "view-hierarchy")))))

branches/working-0711/ccl/examples/cocoa/easygui/new-cocoa-bindings.lisp

@@ -50 +50 @@
              (ns:ns-rect-width r) (ns:ns-rect-height r)))
 
-;;;
+;;; Base class for all Cocoa-based Easygui objects:
 (defclass easy-cocoa-object ()
-     ((ref :initarg :cocoa-ref :accessor cocoa-ref)))
+     ((ref :initarg :cocoa-ref)
+      (ref-valid-p :initform t :accessor cocoa-ref-valid-p)))
+
+(defgeneric cocoa-ref (eg-object)
+  (:method ((eg-object easy-cocoa-object))
+     (if (cocoa-ref-valid-p eg-object)
+         (slot-value eg-object 'ref)
+         (error "Attempting to access an invalidated Cocoa object on ~A!"
+                eg-object))))
+  
+(defgeneric (setf cocoa-ref) (new eg-object)
+  (:method (new (eg-object easy-cocoa-object))
+     (setf (cocoa-ref-valid-p eg-object) t
+           (slot-value eg-object 'ref) new)))
 
 (defvar *window-position-default-x* 200)
@@ -81 +94 @@
 (defun key-mask (keyword)
   (or (cdr (assoc keyword *key-to-mask-alist*)) 0))
+
+;;; Memory management helpers:
+
+(defmacro maybe-invalidating-object ((eg-object) &body body)
+  `(if (= 1 (#/retainCount (cocoa-ref ,eg-object)))
+       (multiple-value-prog1 (progn ,@body)
+                             (setf (cocoa-ref-valid-p ,eg-object) nil))
+       (progn ,@body)))
+
+(defmethod retain-object ((o easy-cocoa-object))
+  (#/retain (cocoa-ref o)))
+
+(defmethod release-object ((o easy-cocoa-object))
+  (#/release (cocoa-ref o)))
+
+(defmacro retaining-objects ((&rest eg-objects) &body body)
+  "Retains EG-OBJECTS, runs BODY forms and releases them after control
+has left BODY."
+  (let ((objects (gensym)))
+    `(let ((,objects (list ,@eg-objects)))
+       (mapc #'retain-object ,objects)
+       (unwind-protect (progn ,@body)
+         (mapc #'release-object ,objects)))))
 
 ;;; debug macro for #/ funcalls:

branches/working-0711/ccl/examples/cocoa/easygui/package.lisp

@@ -5 +5 @@
            #:point-x #:point-y #:rectangle-x #:rectangle-y #:rectangle-width
            #:rectangle-height
+           ;; cocoa stuff
+           #:retain-object #:release-object #:retaining-objects
            ;; view classes
            #:view #:static-text-view #:text-input-view #:password-input-view
@@ -13 +15 @@
            ;; operators
            #:cocoa-ref
-           #:add-subviews #:window-show #:set-window-title
+           #:add-subviews #:remove-subviews #:window-show #:set-window-title
            #:content-view
            #:initialize-view #:action #:view-text
            #:add-entry #:add-entries #:editable-p
            #:draw-view-rectangle
-           #:entry-text #:nth-cell #:selection #:redisplay
+           #:entry-text #:cell-count #:nth-cell #:selection #:redisplay
            #:string-value-of #:integer-value-of #:float-value-of
            #:double-value-of))

branches/working-0711/ccl/examples/cocoa/easygui/views.lisp

@@ -11 +11 @@
   (:documentation "Adds a subview to another view in the view hierarchy."))
 
+(defgeneric remove-1-subview (view super-view)
+  (:documentation "Removes a view from its superview, possibly deallocating it.
+To avoid deallocation, use RETAINING-OBJECTS"))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -147 +150 @@
      ())
 
-(defclass box-view (content-view-mixin view) ())
+(defclass box-view (content-view-mixin view-text-via-title-mixin view) ())
 
 (defclass drawing-view (view)
@@ -306 +309 @@
   superview)
 
+(defmethod remove-1-subview ((view view) (cw-view content-view-mixin))
+  (remove-1-subview view (content-view cw-view)))
+
+(defmethod remove-1-subview ((view view) (super-view view))
+  (assert (eql (cocoa-ref super-view) (#/superview (cocoa-ref view))))
+  (maybe-invalidating-object (view)
+    (#/removeFromSuperview (cocoa-ref view))))
+
+(defun remove-subviews (superview subview &rest subviews)
+  (remove-1-subview subview superview)
+  (dolist (subview subviews)
+    (remove-1-subview subview superview))
+  superview)
+
 (defmethod window-show ((window window))
   (dcc (#/makeKeyAndOrderFront: (cocoa-ref window) nil))
@@ -323 +340 @@
                                     (slot-value view 'autosize-cells-p)))))
 
+(defmethod cell-count ((view form-view))
+  (dcc (#/numberOfRows (cocoa-ref view))))
+
 (defmethod nth-cell (index view)
+  (assert (< index (cell-count view)))
   (let ((cocoa-cell (dcc (#/cellAtIndex: (cocoa-ref view) index))))
     (when cocoa-cell