Changeset 13673


Ignore:
Timestamp:
Apr 26, 2010, 2:30:53 PM (10 years ago)
Author:
plkrueger
Message:

Rev 2.1 UserInterfaceTutorial?

Location:
trunk/source/contrib/krueger/InterfaceProjects
Files:
55 added
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/contrib/krueger/InterfaceProjects/Controller Test 1/lc-test1.nib/designable.nib

    r13631 r13673  
    658658                                                        <bool key="EncodedWithXMLCoder">YES</bool>
    659659                                                        <reference ref="113258462"/>
     660                                                        <reference ref="896457276"/>
    660661                                                        <reference ref="505926526"/>
    661                                                         <reference ref="896457276"/>
    662662                                                </object>
    663663                                                <reference key="parent" ref="1005"/>
    … …  
    884884                        </object>
    885885                        <nil key="sourceID"/>
    886                         <int key="maxID">68</int>
     886                        <int key="maxID">73</int>
    887887                </object>
    888888                <object class="IBClassDescriber" key="IBDocument.Classes">

  • trunk/source/contrib/krueger/InterfaceProjects/Lisp IB Plugins/LispControllerPlugin/LispControllerPlugin.xcodeproj/paul.mode1v3

    r13631 r13673  
    339339                                                                                <integer>0</integer>
    340340                                                                                <key>bookmark</key>
    341                                                                                 <string>DA00DBC31178125F00587AEB</string>
     341                                                                                <string>DA194E7E11836D8F004F4DD5</string>
    342342                                                                                <key>history</key>
    343343                                                                                <array>
    … …  
    354354                                                                                        <string>DA59444F115508DC0078AFE8</string>
    355355                                                                                        <string>DA279E051173F1E1003793F6</string>
    356                                                                                         <string>DA426AF911776A5B00676CD2</string>
     356                                                                                        <string>DA00DBC31178125F00587AEB</string>
    357357                                                                                </array>
    358358                                                                                <key>prevStack</key>
    … …  
    428428                        <key>TableOfContents</key>
    429429                        <array>
    430                                 <string>DA00DBC41178125F00587AEB</string>
     430                                <string>DA194E7511836D8F004F4DD5</string>
    431431                                <string>1CE0B1FE06471DED0097A5F4</string>
    432                                 <string>DA00DBC51178125F00587AEB</string>
     432                                <string>DA194E7611836D8F004F4DD5</string>
    433433                                <string>1CE0B20306471E060097A5F4</string>
    434434                                <string>1CE0B20506471E060097A5F4</string>
    … …  
    646646                        <array>
    647647                                <string>DACE789C111B58AD00886DC9</string>
    648                                 <string>DA00DBC61178125F00587AEB</string>
     648                                <string>DA194E7711836D8F004F4DD5</string>
    649649                                <string>1CD0528F0623707200166675</string>
    650650                                <string>XCMainBuildResultsModuleGUID</string>
    … …  
    766766                        <array>
    767767                                <string>1CD10A99069EF8BA00B06720</string>
    768                                 <string>DA00DBC71178125F00587AEB</string>
     768                                <string>DA194E7811836D8F004F4DD5</string>
    769769                                <string>1C162984064C10D400B95A72</string>
    770                                 <string>DA00DBC81178125F00587AEB</string>
    771                                 <string>DA00DBC91178125F00587AEB</string>
    772                                 <string>DA00DBCA1178125F00587AEB</string>
    773                                 <string>DA00DBCB1178125F00587AEB</string>
    774                                 <string>DA00DBCC1178125F00587AEB</string>
     770                                <string>DA194E7911836D8F004F4DD5</string>
     771                                <string>DA194E7A11836D8F004F4DD5</string>
     772                                <string>DA194E7B11836D8F004F4DD5</string>
     773                                <string>DA194E7C11836D8F004F4DD5</string>
     774                                <string>DA194E7D11836D8F004F4DD5</string>
    775775                        </array>
    776776                        <key>ToolbarConfiguration</key>

  • trunk/source/contrib/krueger/InterfaceProjects/Lisp IB Plugins/LispControllerPlugin/LispControllerPlugin.xcodeproj/paul.pbxuser

    r13631 r13673  
    123123                                );
    124124                        };
    125                         PBXPerProjectTemplateStateSaveDate = 293081615;
    126                         PBXWorkspaceStateSaveDate = 293081615;
     125                        PBXPerProjectTemplateStateSaveDate = 293825908;
     126                        PBXWorkspaceStateSaveDate = 293825908;
    127127                };
    128128                perUserProjectItems = {
    129129                        DA00DBC31178125F00587AEB /* PBXTextBookmark */ = DA00DBC31178125F00587AEB /* PBXTextBookmark */;
     130                        DA194E7E11836D8F004F4DD5 /* PBXTextBookmark */ = DA194E7E11836D8F004F4DD5 /* PBXTextBookmark */;
    130131                        DA279E051173F1E1003793F6 /* PBXTextBookmark */ = DA279E051173F1E1003793F6 /* PBXTextBookmark */;
    131                         DA426AF911776A5B00676CD2 /* PBXTextBookmark */ = DA426AF911776A5B00676CD2 /* PBXTextBookmark */;
    132132                        DA47DC531121B0B30028C558 /* PBXTextBookmark */ = DA47DC531121B0B30028C558 /* PBXTextBookmark */;
    133133                        DA59442C114D3A2B0078AFE8 /* PBXTextBookmark */ = DA59442C114D3A2B0078AFE8 /* PBXTextBookmark */;
    … …  
    276276                vrLoc = 135;
    277277        };
    278         DA279E051173F1E1003793F6 /* PBXTextBookmark */ = {
    279                 isa = PBXTextBookmark;
    280                 fRef = DACE7918111C867D00886DC9 /* LispControllerInspector.m */;
    281                 name = "LispControllerInspector.m: 101";
    282                 rLen = 0;
    283                 rLoc = 3032;
    284                 rType = 0;
    285                 vrLen = 1057;
    286                 vrLoc = 2550;
    287         };
    288         DA426AF911776A5B00676CD2 /* PBXTextBookmark */ = {
     278        DA194E7E11836D8F004F4DD5 /* PBXTextBookmark */ = {
    289279                isa = PBXTextBookmark;
    290280                fRef = DACE7902111B6F4B00886DC9 /* LispController.m */;
    … …  
    295285                vrLen = 1133;
    296286                vrLoc = 135;
     287        };
     288        DA279E051173F1E1003793F6 /* PBXTextBookmark */ = {
     289                isa = PBXTextBookmark;
     290                fRef = DACE7918111C867D00886DC9 /* LispControllerInspector.m */;
     291                name = "LispControllerInspector.m: 101";
     292                rLen = 0;
     293                rLoc = 3032;
     294                rType = 0;
     295                vrLen = 1057;
     296                vrLoc = 2550;
    297297        };
    298298        DA47DBFD1120E5170028C558 /* LispIntegration.m */ = {

  • trunk/source/contrib/krueger/InterfaceProjects/Loan Calc/loan.nib/designable.nib

    r13390 r13673  
    12031203                                <object class="IBConnectionRecord">
    12041204                                        <object class="IBBindingConnection" key="connection">
    1205                                                 <string key="label">value: loan.loanAmt</string>
    1206                                                 <reference key="source" ref="809137054"/>
    1207                                                 <reference key="destination" ref="1001"/>
    1208                                                 <object class="NSNibBindingConnector" key="connector">
    1209                                                         <reference key="NSSource" ref="809137054"/>
    1210                                                         <reference key="NSDestination" ref="1001"/>
    1211                                                         <string key="NSLabel">value: loan.loanAmt</string>
    1212                                                         <string key="NSBinding">value</string>
    1213                                                         <string key="NSKeyPath">loan.loanAmt</string>
    1214                                                         <object class="NSDictionary" key="NSOptions">
    1215                                                                 <string key="NS.key.0">NSContinuouslyUpdatesValue</string>
    1216                                                                 <reference key="NS.object.0" ref="5"/>
    1217                                                         </object>
    1218                                                         <int key="NSNibBindingConnectorVersion">2</int>
    1219                                                 </object>
    1220                                         </object>
    1221                                         <int key="connectionID">153</int>
    1222                                 </object>
    1223                                 <object class="IBConnectionRecord">
    1224                                         <object class="IBBindingConnection" key="connection">
    12251205                                                <string key="label">value: loan.interestRate</string>
    12261206                                                <reference key="source" ref="583982648"/>
    … …  
    14471427                                        </object>
    14481428                                        <int key="connectionID">171</int>
     1429                                </object>
     1430                                <object class="IBConnectionRecord">
     1431                                        <object class="IBBindingConnection" key="connection">
     1432                                                <string key="label">value: loan.loanAmt</string>
     1433                                                <reference key="source" ref="809137054"/>
     1434                                                <reference key="destination" ref="1001"/>
     1435                                                <object class="NSNibBindingConnector" key="connector">
     1436                                                        <reference key="NSSource" ref="809137054"/>
     1437                                                        <reference key="NSDestination" ref="1001"/>
     1438                                                        <string key="NSLabel">value: loan.loanAmt</string>
     1439                                                        <string key="NSBinding">value</string>
     1440                                                        <string key="NSKeyPath">loan.loanAmt</string>
     1441                                                        <object class="NSDictionary" key="NSOptions">
     1442                                                                <string key="NS.key.0">NSContinuouslyUpdatesValue</string>
     1443                                                                <reference key="NS.object.0" ref="5"/>
     1444                                                        </object>
     1445                                                        <int key="NSNibBindingConnectorVersion">2</int>
     1446                                                </object>
     1447                                        </object>
     1448                                        <int key="connectionID">174</int>
    14491449                                </object>
    14501450                        </object>
    … …  
    20722072                        </object>
    20732073                        <nil key="sourceID"/>
    2074                         <int key="maxID">171</int>
     2074                        <int key="maxID">174</int>
    20752075                </object>
    20762076                <object class="IBClassDescriber" key="IBDocument.Classes">

  • trunk/source/contrib/krueger/InterfaceProjects/Utilities/lisp-controller.lisp

    r13631 r13673  
    425425   (children-func :accessor children-func)
    426426   (type-info :accessor type-info)
    427    (obj-wrappers :accessor obj-wrappers)
    428427   (column-info :accessor column-info)
    429428   (nib-initialized :accessor nib-initialized)
    … …  
    566565  (setf (assoc-aref (type-info self) 'vector :initform)
    567566        '(make-array '(10) :adjustable t :fill-pointer 0 :initial-element nil))
    568   (unless (slot-boundp self 'obj-wrappers)
    569     (setf (obj-wrappers self) (make-instance 'assoc-array :rank 1)))
    570567  self)
    571568
    … …  
    573570                ((self lisp-controller))
    574571  (setf (nib-initialized self) t)
    575   (unless (eql (view self) (%null-ptr))
    576     (setf (view-class self) (#/class (view self)))
    577     (init-column-info self (view self))
     572  (let ((has-valid-view (and (slot-boundp self 'view)
     573                             (not (eql (view self) (%null-ptr))))))
     574    (when has-valid-view
     575      (setf (view-class self) (#/class (view self)))
     576      (init-column-info self (view self)))
    578577    (when (gen-root self)
    579578      ;; create the root object
    580579      (setf (root self) (new-object-of-type self (root-type self))))
    581     (when (objects self)
     580    (when (and has-valid-view (objects self))
    582581      (setup-accessors self))))
    583582
    … …  
    752751    (when (not (subtypep typ rt))
    753752      ;; trying to set root to something other than what was specified in IB
    754       (error "Type of ~s (~s) is not a subtype of ~s" new-obj typ rt))))
     753      (error "Type of ~s (~s) is not a subtype of ~s" new-obj typ rt)))
     754  (#/willChangeValueForKey: self #@"root"))
    755755
    756756(defmethod (setf root) :after (new-obj (self lisp-controller))
    757757  ;; cache the children of the root object because they are used so frequently
    758758  (setf (objects self) (children-of-object self new-obj))
    759   (when (nib-initialized self)
     759  (#/didChangeValueForKey: self #@"root")
     760  (when (and (nib-initialized self) (not (eql (view self) (%null-ptr))))
    760761    (setup-accessors self)
    761762    (set-can-insert self new-obj)
    … …  
    10451046                 (item :id))
    10461047  (declare (ignore olview))
    1047   (with-slots (obj-wrappers objects) self
     1048  (with-slots (objects) self
    10481049    (cond ((typep item 'lisp-ptr-wrapper)
    10491050           (let* ((parent (lpw-lisp-ptr item))
    … …  
    10511052                  (children (children-of-object self parent))
    10521053                  (child-ptr (elt children child)))
    1053              (or (assoc-aref obj-wrappers child-ptr)
    1054                  (setf (assoc-aref obj-wrappers child-ptr)
    1055                        (make-ptr-wrapper child-ptr
    1056                                          :depth (1+ parent-depth)
    1057                                          :parent parent)))))
     1054             (wrapper-for self child-ptr :depth (1+ parent-depth) :parent parent)))
    10581055          ((eql item (%null-ptr))
    10591056           (let ((child-ptr (elt objects child)))
    1060              (or (assoc-aref obj-wrappers child-ptr)
    1061                  (setf (assoc-aref obj-wrappers child-ptr)
    1062                        (make-ptr-wrapper child-ptr :depth 1 :parent nil)))))
     1057             (wrapper-for self child-ptr :depth 1)))
    10631058          (t
    10641059           (%null-ptr)))))
    … …  
    11831178        (#/reloadData (view self))))))
    11841179
     1180
     1181;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1182;; Methods for using a lisp-controller as an initial binding target
     1183;; Binding paths must start with "root" or "selected" and can use
     1184;; lisp accessors from that point to other lisp targets.
     1185;; Any atomic value found by following the path is converted to an
     1186;; Objective-C value and returned. If a non-atomic value is found by
     1187;; following the path it is encapsulated within a lisp-ptr-wrapper object
     1188;; and returned. When that path is subsequently followed the lisp-ptr-wrapper
     1189;; will handle the path reference in the same way.
     1190
     1191(objc:defmethod (#/root :id)
     1192                ((self lisp-controller))
     1193  (cond ((typep (root self) 'objc:objc-object)
     1194             (root self))
     1195        ((null (root self))
     1196         (%null-ptr))
     1197        ((typep (root self) 'objc-displayable)
     1198         (lisp-to-ns-object (root self)))
     1199        (t
     1200         (wrapper-for self (root self)))))
     1201
     1202(objc:defmethod (#/selection :id)
     1203                ((self lisp-controller))
     1204  (let* ((row-num (#/selectedRow (view self)))
     1205         (obj (object-at-row self row-num)))
     1206    (cond ((typep obj 'objc:objc-object)
     1207           obj)
     1208          ((typep obj 'objc-displayable)
     1209           (lisp-to-ns-object obj))
     1210          (t
     1211           (wrapper-for self obj)))))
     1212
    11851213(provide :lisp-controller)
    11861214     

  • trunk/source/contrib/krueger/InterfaceProjects/Utilities/ns-object-utils.lisp

    r13631 r13673  
    2727(eval-when (:compile-toplevel :load-toplevel :execute)
    2828  (require :ns-string-utils)
     29  (require :ns-binding-utils)
     30  (require :nslog-utils)
    2931  (require :date)
    30   (require :decimal))
     32  (require :decimal)
     33  (require :assoc-array))
    3134
    3235
    … …  
    3437  (:nicknames :iu)
    3538  (:export
     39   did-change-value-for-key
     40   lisp-to-ns-array
     41   lisp-to-ns-dict
    3642   lisp-to-ns-object
    3743   lisp-ptr-wrapper
    … …  
    4046   lpw-parent
    4147   make-ptr-wrapper
     48   ns-to-lisp-array
     49   ns-to-lisp-assoc
     50   ns-to-lisp-hash-table
     51   ns-to-lisp-list
    4252   ns-to-lisp-object
    43    print-ns-object))
     53   objc-displayable
     54   print-ns-object
     55   will-change-value-for-key
     56   wrapper-for))
    4457
    4558(in-package :iu)
    … …  
    6376         (lpw-lisp-ptr ns-obj))
    6477        ((typep ns-obj 'ns:ns-decimal)
    65          (if (floatp old-lisp-obj)
     78         (if (or (floatp old-lisp-obj) (eq :float old-lisp-obj))
    6679           ;; convert the decimal to a float
    6780           (#/doubleValue ns-obj)
    … …  
    7689        ((typep ns-obj 'ns:ns-date)
    7790         (ns-to-lisp-date ns-obj))
     91        ((typep ns-obj 'ns:ns-dictionary)
     92         (if (or (consp old-lisp-obj) (eq old-lisp-obj :cons))
     93           (ns-to-lisp-assoc ns-obj)
     94           (ns-to-lisp-hash-table ns-obj)))
     95        ((typep ns-obj 'ns:ns-array)
     96         (if (or (consp old-lisp-obj) (eq old-lisp-obj :cons))
     97           (ns-to-lisp-list ns-obj)
     98           (ns-to-lisp-array ns-obj)))
     99        ((typep ns-obj 'ns:ns-string)
     100         (let ((str (ns-to-lisp-string ns-obj)))
     101           (if (or (stringp old-lisp-obj) (eq old-lisp-obj :string))
     102             str
     103             (read-from-string str nil nil))))
     104        ((typep ns-obj 'ns:ns-null)
     105         nil)
    78106        (t
    79          (let ((str (ns-to-lisp-string ns-obj)))
    80            (if (stringp old-lisp-obj)
    81              str
    82              (read-from-string str nil nil))))))
     107         ;; can't convert so just return ns-obj
     108         ns-obj)))
    83109
    84110(defun lisp-to-ns-object (lisp-obj &optional (ns-format nil))
    … …  
    105131        ((floatp lisp-obj)
    106132         (#/numberWithFloat: ns:ns-number lisp-obj))
     133        ((stringp lisp-obj)
     134         (lisp-to-temp-nsstring lisp-obj))
     135        ((hash-table-p lisp-obj)
     136         (lisp-to-ns-dict lisp-obj))
     137        ((vectorp lisp-obj)
     138         (lisp-to-ns-array lisp-obj))
    107139        ((null lisp-obj)
    108140         #@"")
    109141        (t
    110          (lisp-to-temp-nsstring (if (stringp lisp-obj)
    111                                   lisp-obj
    112                                   (format nil "~s" lisp-obj))))))
     142         (lisp-to-temp-nsstring (format nil "~s" lisp-obj)))))
     143
     144;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     145;; Methods dealing with NSArray objects
     146
     147(defmethod ns-to-lisp-array ((ns-arr ns:ns-array) &key (no-convert nil))
     148  (let* ((count (#/count ns-arr))
     149         (new-arr (make-array (list count))))
     150    (dotimes (i count new-arr)
     151        (setf (aref new-arr i)
     152              (if no-convert
     153                (#/objectAtIndex: ns-arr i)
     154                (ns-to-lisp-object nil (#/objectAtIndex: ns-arr i)))))))
     155
     156(defmethod ns-to-lisp-list ((ns-arr ns:ns-array) &key (no-convert nil))
     157  (let* ((count (#/count ns-arr))
     158         (new-list nil))
     159    (dotimes (i count (nreverse new-list))
     160        (setf new-list
     161              (cons (if no-convert
     162                      (#/objectAtIndex: ns-arr i)
     163                      (ns-to-lisp-object nil (#/objectAtIndex: ns-arr i)))
     164                    new-list)))))
     165
     166(defmethod lisp-to-ns-array ((lst list))
     167  (let ((new-arr (#/arrayWithCapacity: ns:ns-mutable-array (list-length lst)))
     168        (count -1))
     169    (dolist (item lst new-arr)
     170      (#/insertObject:atIndex: new-arr
     171                               (lisp-to-ns-object item)
     172                               (incf count)))))
     173
     174(defmethod lisp-to-ns-array ((arr array))
     175  (let* ((max-count (if (array-has-fill-pointer-p arr)
     176                     (fill-pointer arr)
     177                     (length arr)))
     178         (new-arr (#/arrayWithCapacity: ns:ns-mutable-array max-count)))
     179    (do* ((count 0 (1+ count)))
     180         ((>= count max-count) new-arr)
     181      (#/insertObject:atIndex: new-arr
     182                               (lisp-to-ns-object (aref arr count))
     183                               count))))
     184
     185;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     186;; Methods dealing with NSDictionary objects
     187
     188(defmethod ns-to-lisp-hash-table ((dict ns:ns-dictionary) &key (no-convert nil))
     189  (let ((ht (make-hash-table))
     190        (dict-keys (ns-to-lisp-list (#/allKeys dict) :no-convert t)))
     191    (dolist (key dict-keys ht)
     192      (setf (gethash (ns-to-lisp-object nil key) ht)
     193            (if no-convert
     194              (#/objectForKey: dict key)
     195              (ns-to-lisp-object nil (#/objectForKey: dict key)))))))
     196
     197(defmethod ns-to-lisp-assoc ((dict ns:ns-dictionary) &key (no-convert nil))
     198  (let ((assoc-lst nil)
     199        (dict-keys (ns-to-lisp-list (#/allKeys dict) :no-convert t)))
     200    (dolist (key dict-keys assoc-lst)
     201      (setf assoc-lst
     202            (acons (ns-to-lisp-object nil key)
     203                   (if no-convert
     204                     (#/objectForKey: dict key)
     205                     (ns-to-lisp-object nil (#/objectForKey: dict key)))
     206                   assoc-lst)))))
     207
     208(defmethod lisp-to-ns-dict ((alist list))
     209  ;; alist must be in the form of an association list
     210  (let* ((count (list-length alist))
     211         (new-dict (#/dictionaryWithCapacity: ns:ns-mutable-dictionary count)))
     212    (dolist (pair alist new-dict)
     213      (#/setObject:forKey: new-dict
     214                           (lisp-to-ns-object nil (cdr pair))
     215                           (lisp-to-ns-object nil (car pair))))))
     216
     217(defmethod lisp-to-ns-dict ((ht hash-table))
     218  (let* ((count (hash-table-count ht))
     219         (new-dict (#/dictionaryWithCapacity: ns:ns-mutable-dictionary count)))
     220    (maphash #'(lambda (key val)
     221                 (#/setObject:forKey: new-dict
     222                                      (lisp-to-ns-object nil val)
     223                                      (lisp-to-ns-object nil key)))
     224             ht)
     225    new-dict))
    113226
    114227;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    … …  
    117230;; This is a simple class that encapsulates a pointer to a lisp object so we can pass this
    118231;; off to an Objective-C view and know what it points to when we get it back later.
     232;; Added is the ability to handle bindings
     233
     234(deftype objc-displayable ()
     235  '(and atom
     236       (not sequence)
     237       (not hash-table)
     238       (not package)
     239       (not pathname)
     240       (not random-state)
     241       (not readtable)
     242       (not array)
     243       (not stream)
     244       (not class)
     245       (not structure-object)
     246       (not standard-object)
     247       (not macptr)))
    119248
    120249(defclass lisp-ptr-wrapper (ns:ns-object)
    121250  ((lpw-lisp-ptr :accessor lpw-lisp-ptr)
     251   (lpw-controller :accessor lpw-controller)
    122252   (lpw-depth :accessor lpw-depth)
    123253   (lpw-parent :accessor lpw-parent))
    124254  (:metaclass ns:+ns-object))
    125255
    126 (defun make-ptr-wrapper (ptr &key (depth 1) (parent nil))
    127   (let ((lpw (make-instance 'lisp-ptr-wrapper)))
    128     (setf (lpw-lisp-ptr lpw) ptr)
    129     (setf (lpw-depth lpw) depth)
    130     (setf (lpw-parent lpw) parent)
    131     lpw))
    132 
     256(objc:defmethod (#/copyWithZone: :id)
     257                ((self lisp-ptr-wrapper) (zone (* #>NSZone)))
     258  ;; (ns-log (format nil "Copying wrapper for ~s" (lpw-lisp-ptr self)))
     259  self)
     260
     261(let ((kvc-observed (make-instance 'assoc-array :rank 2))
     262      (obj-wrappers (make-instance 'assoc-array :rank 2)))
     263  ;; this assoc-array keeps track of paths that are being observed and the
     264  ;; corresponding lisp-ptr-wrapper object that is ostensibly being observed.
     265
     266  (defun make-ptr-wrapper (ptr &key (depth 1) (parent nil) (controller nil))
     267    ;; (ns-log (format nil "Making wrapper for ~s" ptr))
     268    (let ((lpw (make-instance 'lisp-ptr-wrapper)))
     269      (setf (lpw-lisp-ptr lpw) ptr)
     270      (setf (lpw-depth lpw) depth)
     271      (setf (lpw-parent lpw) parent)
     272      (setf (lpw-controller lpw) controller)
     273      (setf (assoc-aref obj-wrappers controller ptr) lpw)
     274      lpw))
     275
     276  (defmethod wrapper-for (controller lisp-obj &key (depth 0) (parent nil))
     277    (or (assoc-aref obj-wrappers controller lisp-obj)
     278        (setf (assoc-aref obj-wrappers controller lisp-obj)
     279              (make-ptr-wrapper lisp-obj
     280                                :depth depth
     281                                :parent parent
     282                                :controller controller))))
     283
     284  (defmethod note-kvc-observed ((self lisp-ptr-wrapper) lisp-obj path-sym)
     285    ;; (ns-log (format nil "Observing ~s for ~s" path-sym lisp-obj))
     286    (pushnew self (assoc-aref kvc-observed lisp-obj path-sym)))
     287
     288  (defmethod will-change-value-for-key (owner key)
     289    ;; called from a lisp object to tell us that a value will be changed.
     290    ;; We find the lisp-ptr-wrapper instances that have been used to access
     291    ;; the owner via the specified key and call the appropriate
     292    ;; method to lets KVC know what is going on.
     293    ;; (ns-log (format nil "Will change ~s for ~s" key owner))
     294    (let ((owner-lpws (assoc-aref kvc-observed owner key))
     295          (objc-key (lisp-to-temp-nsstring (lisp-to-objc-keypathname key))))
     296      (dolist (lpw owner-lpws)
     297        ;; (ns-log (format nil "#/willChangeValueForKey: ~s ~s" lpw objc-key))
     298        (#/willChangeValueForKey: lpw objc-key))))
     299
     300  (defmethod did-change-value-for-key (owner key)
     301    ;; called from a lisp object to tell us that a value changed.
     302    ;; We find the lisp-ptr-wrapper instances that have been used to access
     303    ;; the owner via the specified key and call the appropriate
     304    ;; method to lets KVC know what is going on.
     305    ;; (ns-log (format nil "Did change ~s for ~s" key owner))
     306    (let ((owner-lpws (assoc-aref kvc-observed owner key))
     307          (objc-key (lisp-to-temp-nsstring (lisp-to-objc-keypathname key))))
     308      (dolist (lpw owner-lpws)
     309        ;; (ns-log (format nil "#/didChangeValueForKey: ~s ~s" lpw objc-key))
     310        (#/didChangeValueForKey: lpw objc-key))))
     311
     312  (defun kvc-observed ()
     313    kvc-observed)
     314)
     315;; end of definitions with access to kvc-observed assoc-array
     316
     317(objc:defmethod (#/valueForKey: :id)
     318                ((self lisp-ptr-wrapper) (path :id))
     319  (let* ((lisp-path (objc-to-lisp-keypathname (ns-to-lisp-string path)))
     320         (next-obj (when (and (typep lisp-path 'function-name) (fboundp lisp-path))
     321                     (funcall lisp-path (lpw-lisp-ptr self)))))
     322    ;; First track that the path is being observed by somebody
     323    (note-kvc-observed self (lpw-lisp-ptr self) lisp-path)
     324    ;; (ns-log (format nil "(~s ~s) returned ~s" lisp-path (lpw-lisp-ptr self) next-obj))
     325    (cond ((typep next-obj 'objc:objc-object)
     326           next-obj)
     327          ((null next-obj)
     328           (%null-ptr))
     329          ((typep next-obj 'objc-displayable)
     330           (lisp-to-ns-object next-obj))
     331          (t
     332           (wrapper-for (lpw-controller self) next-obj :parent (lpw-lisp-ptr self))))))
     333
     334(objc:defmethod (#/setValue:forKey: :void)
     335                ((self lisp-ptr-wrapper) (new-value :id) (path :id))
     336  (let* ((lisp-path (objc-to-lisp-keypathname (ns-to-lisp-string path)))
     337         (prev-obj (when (and (typep lisp-path 'function-name) (fboundp lisp-path))
     338                     (funcall lisp-path (lpw-lisp-ptr self))))
     339         (new-lisp-obj (ns-to-lisp-object prev-obj new-value))
     340         (setf-form `(setf (,lisp-path ,(lpw-lisp-ptr self)) ,new-lisp-obj)))
     341    ;; (ns-log (format nil "Evaling ~s" setf-form))
     342    (handler-case (eval setf-form)
     343      (condition (c)
     344                 (ns-log (format nil "condition: ~s evaling ~s" c setf-form))))))
    133345
    134346(provide :ns-object-utils)

  • trunk/source/contrib/krueger/InterfaceProjects/Utilities/ns-string-utils.lisp

    r13631 r13673  
    11;; ns-string-utils.lisp
     2#|
     3The MIT license.
     4
     5Copyright (c) 2010 Paul L. Krueger
     6
     7Permission is hereby granted, free of charge, to any person obtaining a copy of this software
     8and associated documentation files (the "Software"), to deal in the Software without restriction,
     9including without limitation the rights to use, copy, modify, merge, publish, distribute,
     10sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
     11furnished to do so, subject to the following conditions:
     12
     13The above copyright notice and this permission notice shall be included in all copies or substantial
     14portions of the Software.
     15
     16THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT
     17LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
     18IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
     19WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
     20SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
     21
     22|#
    223
    324(defpackage :interface-utilities
    … …  
    526  (:export ns-to-lisp-string lisp-str-to-ns-data ns-data-to-lisp-str
    627           lisp-object-to-ns-data ns-data-to-lisp-object lisp-to-temp-nsstring
    7            nsstring-to-class nsstring-to-func nsstring-to-sym find-func))
     28           nsstring-to-class nsstring-to-func nsstring-to-sym find-func find-substring))
    829
    930(in-package :iu)
    … …  
    5879    (if (symbolp sym) sym nil)))
    5980
     81(defun find-substring (substr str &key (test #'string=))
     82  (let* ((first-char (elt substr 0))
     83         (count (length substr))
     84         (search-end (1+ (- (length str) count))))
     85    (do* ((begin (position first-char str :end search-end)
     86                 (position first-char str :start (1+ begin) :end search-end)))
     87         ((null begin) nil)
     88      (if (funcall test substr (subseq str begin (+ begin count)))
     89        (return-from find-substring t)))))
     90
    6091(provide :ns-string-utils)
Note: See TracChangeset for help on using the changeset viewer.