Changeset 13673
- Timestamp:
- Apr 26, 2010, 2:30:53 PM (10 years ago)
- 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 658 658 <bool key="EncodedWithXMLCoder">YES</bool> 659 659 <reference ref="113258462"/> 660 <reference ref="896457276"/> 660 661 <reference ref="505926526"/> 661 <reference ref="896457276"/>662 662 </object> 663 663 <reference key="parent" ref="1005"/> … … 884 884 </object> 885 885 <nil key="sourceID"/> 886 <int key="maxID"> 68</int>886 <int key="maxID">73</int> 887 887 </object> 888 888 <object class="IBClassDescriber" key="IBDocument.Classes"> -
trunk/source/contrib/krueger/InterfaceProjects/Lisp IB Plugins/LispControllerPlugin/LispControllerPlugin.xcodeproj/paul.mode1v3
r13631 r13673 339 339 <integer>0</integer> 340 340 <key>bookmark</key> 341 <string>DA 00DBC31178125F00587AEB</string>341 <string>DA194E7E11836D8F004F4DD5</string> 342 342 <key>history</key> 343 343 <array> … … 354 354 <string>DA59444F115508DC0078AFE8</string> 355 355 <string>DA279E051173F1E1003793F6</string> 356 <string>DA 426AF911776A5B00676CD2</string>356 <string>DA00DBC31178125F00587AEB</string> 357 357 </array> 358 358 <key>prevStack</key> … … 428 428 <key>TableOfContents</key> 429 429 <array> 430 <string>DA 00DBC41178125F00587AEB</string>430 <string>DA194E7511836D8F004F4DD5</string> 431 431 <string>1CE0B1FE06471DED0097A5F4</string> 432 <string>DA 00DBC51178125F00587AEB</string>432 <string>DA194E7611836D8F004F4DD5</string> 433 433 <string>1CE0B20306471E060097A5F4</string> 434 434 <string>1CE0B20506471E060097A5F4</string> … … 646 646 <array> 647 647 <string>DACE789C111B58AD00886DC9</string> 648 <string>DA 00DBC61178125F00587AEB</string>648 <string>DA194E7711836D8F004F4DD5</string> 649 649 <string>1CD0528F0623707200166675</string> 650 650 <string>XCMainBuildResultsModuleGUID</string> … … 766 766 <array> 767 767 <string>1CD10A99069EF8BA00B06720</string> 768 <string>DA 00DBC71178125F00587AEB</string>768 <string>DA194E7811836D8F004F4DD5</string> 769 769 <string>1C162984064C10D400B95A72</string> 770 <string>DA 00DBC81178125F00587AEB</string>771 <string>DA 00DBC91178125F00587AEB</string>772 <string>DA 00DBCA1178125F00587AEB</string>773 <string>DA 00DBCB1178125F00587AEB</string>774 <string>DA 00DBCC1178125F00587AEB</string>770 <string>DA194E7911836D8F004F4DD5</string> 771 <string>DA194E7A11836D8F004F4DD5</string> 772 <string>DA194E7B11836D8F004F4DD5</string> 773 <string>DA194E7C11836D8F004F4DD5</string> 774 <string>DA194E7D11836D8F004F4DD5</string> 775 775 </array> 776 776 <key>ToolbarConfiguration</key> -
trunk/source/contrib/krueger/InterfaceProjects/Lisp IB Plugins/LispControllerPlugin/LispControllerPlugin.xcodeproj/paul.pbxuser
r13631 r13673 123 123 ); 124 124 }; 125 PBXPerProjectTemplateStateSaveDate = 293 081615;126 PBXWorkspaceStateSaveDate = 293 081615;125 PBXPerProjectTemplateStateSaveDate = 293825908; 126 PBXWorkspaceStateSaveDate = 293825908; 127 127 }; 128 128 perUserProjectItems = { 129 129 DA00DBC31178125F00587AEB /* PBXTextBookmark */ = DA00DBC31178125F00587AEB /* PBXTextBookmark */; 130 DA194E7E11836D8F004F4DD5 /* PBXTextBookmark */ = DA194E7E11836D8F004F4DD5 /* PBXTextBookmark */; 130 131 DA279E051173F1E1003793F6 /* PBXTextBookmark */ = DA279E051173F1E1003793F6 /* PBXTextBookmark */; 131 DA426AF911776A5B00676CD2 /* PBXTextBookmark */ = DA426AF911776A5B00676CD2 /* PBXTextBookmark */;132 132 DA47DC531121B0B30028C558 /* PBXTextBookmark */ = DA47DC531121B0B30028C558 /* PBXTextBookmark */; 133 133 DA59442C114D3A2B0078AFE8 /* PBXTextBookmark */ = DA59442C114D3A2B0078AFE8 /* PBXTextBookmark */; … … 276 276 vrLoc = 135; 277 277 }; 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 */ = { 289 279 isa = PBXTextBookmark; 290 280 fRef = DACE7902111B6F4B00886DC9 /* LispController.m */; … … 295 285 vrLen = 1133; 296 286 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; 297 297 }; 298 298 DA47DBFD1120E5170028C558 /* LispIntegration.m */ = { -
trunk/source/contrib/krueger/InterfaceProjects/Loan Calc/loan.nib/designable.nib
r13390 r13673 1203 1203 <object class="IBConnectionRecord"> 1204 1204 <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">1225 1205 <string key="label">value: loan.interestRate</string> 1226 1206 <reference key="source" ref="583982648"/> … … 1447 1427 </object> 1448 1428 <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> 1449 1449 </object> 1450 1450 </object> … … 2072 2072 </object> 2073 2073 <nil key="sourceID"/> 2074 <int key="maxID">17 1</int>2074 <int key="maxID">174</int> 2075 2075 </object> 2076 2076 <object class="IBClassDescriber" key="IBDocument.Classes"> -
trunk/source/contrib/krueger/InterfaceProjects/Utilities/lisp-controller.lisp
r13631 r13673 425 425 (children-func :accessor children-func) 426 426 (type-info :accessor type-info) 427 (obj-wrappers :accessor obj-wrappers)428 427 (column-info :accessor column-info) 429 428 (nib-initialized :accessor nib-initialized) … … 566 565 (setf (assoc-aref (type-info self) 'vector :initform) 567 566 '(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)))570 567 self) 571 568 … … 573 570 ((self lisp-controller)) 574 571 (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))) 578 577 (when (gen-root self) 579 578 ;; create the root object 580 579 (setf (root self) (new-object-of-type self (root-type self)))) 581 (when ( objects self)580 (when (and has-valid-view (objects self)) 582 581 (setup-accessors self)))) 583 582 … … 752 751 (when (not (subtypep typ rt)) 753 752 ;; 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")) 755 755 756 756 (defmethod (setf root) :after (new-obj (self lisp-controller)) 757 757 ;; cache the children of the root object because they are used so frequently 758 758 (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)))) 760 761 (setup-accessors self) 761 762 (set-can-insert self new-obj) … … 1045 1046 (item :id)) 1046 1047 (declare (ignore olview)) 1047 (with-slots (obj -wrappers objects) self1048 (with-slots (objects) self 1048 1049 (cond ((typep item 'lisp-ptr-wrapper) 1049 1050 (let* ((parent (lpw-lisp-ptr item)) … … 1051 1052 (children (children-of-object self parent)) 1052 1053 (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))) 1058 1055 ((eql item (%null-ptr)) 1059 1056 (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))) 1063 1058 (t 1064 1059 (%null-ptr))))) … … 1183 1178 (#/reloadData (view self)))))) 1184 1179 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 1185 1213 (provide :lisp-controller) 1186 1214 -
trunk/source/contrib/krueger/InterfaceProjects/Utilities/ns-object-utils.lisp
r13631 r13673 27 27 (eval-when (:compile-toplevel :load-toplevel :execute) 28 28 (require :ns-string-utils) 29 (require :ns-binding-utils) 30 (require :nslog-utils) 29 31 (require :date) 30 (require :decimal)) 32 (require :decimal) 33 (require :assoc-array)) 31 34 32 35 … … 34 37 (:nicknames :iu) 35 38 (:export 39 did-change-value-for-key 40 lisp-to-ns-array 41 lisp-to-ns-dict 36 42 lisp-to-ns-object 37 43 lisp-ptr-wrapper … … 40 46 lpw-parent 41 47 make-ptr-wrapper 48 ns-to-lisp-array 49 ns-to-lisp-assoc 50 ns-to-lisp-hash-table 51 ns-to-lisp-list 42 52 ns-to-lisp-object 43 print-ns-object)) 53 objc-displayable 54 print-ns-object 55 will-change-value-for-key 56 wrapper-for)) 44 57 45 58 (in-package :iu) … … 63 76 (lpw-lisp-ptr ns-obj)) 64 77 ((typep ns-obj 'ns:ns-decimal) 65 (if ( floatp old-lisp-obj)78 (if (or (floatp old-lisp-obj) (eq :float old-lisp-obj)) 66 79 ;; convert the decimal to a float 67 80 (#/doubleValue ns-obj) … … 76 89 ((typep ns-obj 'ns:ns-date) 77 90 (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) 78 106 (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))) 83 109 84 110 (defun lisp-to-ns-object (lisp-obj &optional (ns-format nil)) … … 105 131 ((floatp lisp-obj) 106 132 (#/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)) 107 139 ((null lisp-obj) 108 140 #@"") 109 141 (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)) 113 226 114 227 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; … … 117 230 ;; This is a simple class that encapsulates a pointer to a lisp object so we can pass this 118 231 ;; 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))) 119 248 120 249 (defclass lisp-ptr-wrapper (ns:ns-object) 121 250 ((lpw-lisp-ptr :accessor lpw-lisp-ptr) 251 (lpw-controller :accessor lpw-controller) 122 252 (lpw-depth :accessor lpw-depth) 123 253 (lpw-parent :accessor lpw-parent)) 124 254 (:metaclass ns:+ns-object)) 125 255 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)))))) 133 345 134 346 (provide :ns-object-utils) -
trunk/source/contrib/krueger/InterfaceProjects/Utilities/ns-string-utils.lisp
r13631 r13673 1 1 ;; ns-string-utils.lisp 2 #| 3 The MIT license. 4 5 Copyright (c) 2010 Paul L. Krueger 6 7 Permission is hereby granted, free of charge, to any person obtaining a copy of this software 8 and associated documentation files (the "Software"), to deal in the Software without restriction, 9 including without limitation the rights to use, copy, modify, merge, publish, distribute, 10 sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is 11 furnished to do so, subject to the following conditions: 12 13 The above copyright notice and this permission notice shall be included in all copies or substantial 14 portions of the Software. 15 16 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT 17 LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 18 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 19 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 22 |# 2 23 3 24 (defpackage :interface-utilities … … 5 26 (:export ns-to-lisp-string lisp-str-to-ns-data ns-data-to-lisp-str 6 27 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)) 8 29 9 30 (in-package :iu) … … 58 79 (if (symbolp sym) sym nil))) 59 80 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 60 91 (provide :ns-string-utils)
Note: See TracChangeset
for help on using the changeset viewer.