Changeset 14594
- Timestamp:
- Jan 23, 2011, 10:33:07 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/ns-object-utils.lisp
r14591 r14594 736 736 ;; Objective-C objects that have associated formatter objects from which we can take hints. 737 737 738 (objc:defmethod (#/addObserver:forKeyPath:options:context: :void) 739 ((self lisp-ptr-wrapper) (obs :id) (key-path :id) (options #>NSUInteger) (context :address)) 740 (let ((observer (real-observer obs))) 741 (ns-log (format nil "~s observed by ~s" (lpw-lisp-ptr self) observer)) 742 (when (subtypep (type-of observer) 'ns:ns-control) 743 (let* ((cell (#/cell observer)) 744 (formatter (#/formatter cell)) 745 (ns-format nil)) 746 (cond ((or (typep cell 'ns:ns-date-picker-cell) 747 (typep formatter 'ns:ns-date-formatter)) 748 (setf ns-format :date)) 749 ((typep formatter 'ns:ns-number-formatter) 750 (cond ((#/generatesDecimalNumbers formatter) 751 (let ((dec-digits (#/maximumFractionDigits formatter))) 752 (setf ns-format (list :decimal dec-digits)))) 753 (t 754 (setf ns-format :number))))) 755 (when ns-format 756 (ns-log (format nil "Observer data format: ~s" ns-format)) 757 (setf (assoc-aref format-assoc self (ns-to-lisp-string key-path)) ns-format))))) 758 (call-next-method obs key-path options context)) 759 760 (objc:defmethod (#/valueForKey: :id) 761 ((self lisp-ptr-wrapper) (path :id)) 762 ;; Treat path as a lisp path as long as it works. 763 ;; If it is not valid and the next target is an Objective-C object 764 ;; then treat the path as a normal Objective-C Key and return the results 765 ;; of calling #/valueForKey: on the target using path as the key. 766 (let* ((lisp-str (ns-to-lisp-string path)) 767 (lisp-path (objc-to-lisp-keypathname lisp-str)) 768 (ptr-obj (lpw-lisp-ptr self)) 769 ;; to set next-obj we try 3 ways: 770 ;; 1. If the path is a valid lisp function name use it to access the slot 771 ;; 2. If the object is an Objective-C object try calling its #/valueForKey method 772 ;; 3. Look for any KVO slots defined for the object with path specified as the KVO 773 ;; accessor and use the lisp function value-for-kvo-key to access that slot 774 (next-obj (cond ((and (typep lisp-path 'function-name) 775 (fboundp lisp-path)) 776 (funcall lisp-path ptr-obj)) 777 ((and (typep ptr-obj 'objc:objc-object) 778 (#/respondsToSelector: ptr-obj (reader-selector lisp-str))) 779 (#/valueForKey: ptr-obj path)) 780 (t 781 (ccl::value-for-kvo-key ptr-obj lisp-str))))) 782 ;; First track that the path is being observed by somebody 783 (note-kvc-observed self (lpw-lisp-ptr self) lisp-path) 784 (note-kvc-observed self (lpw-lisp-ptr self) lisp-str) 785 ;; (ns-log (format nil "(~s ~s) returned ~s" lisp-path (lpw-lisp-ptr self) next-obj)) 786 (cond ((eql next-obj (%null-ptr)) 787 next-obj) 788 ((null next-obj) 789 (%null-ptr)) 790 ((and (typep next-obj 'ns:ns-object) 791 (not (typep next-obj 'ccl::kvo-object))) 792 ;; any kvo-objects will be encapsulated in a lisp-ptr-wrapper 793 ;; so that subsequent accesses through this method will try to 794 ;; use ccl::value-for-kvo-key 795 next-obj) 796 ((typep next-obj 'objc-displayable) 797 (lisp-to-ns-object next-obj (assoc-aref format-assoc self lisp-str))) 798 (t 799 (wrapper-for (lpw-controller self) next-obj :parent (lpw-lisp-ptr self)))))) 800 801 (objc:defmethod (#/setValue:forKey: :void) 802 ((self lisp-ptr-wrapper) (new-value :id) (path :id)) 803 (let* ((lisp-str (ns-to-lisp-string path)) 804 (lisp-path (objc-to-lisp-keypathname lisp-str)) 805 (ptr-obj (lpw-lisp-ptr self)) 806 (prev-obj (cond ((and (typep lisp-path 'function-name) 807 (fboundp lisp-path)) 808 (funcall lisp-path ptr-obj)) 809 ((and (typep ptr-obj 'objc:objc-object) 810 (#/respondsToSelector: self (reader-selector lisp-str))) 811 (#/valueForKey: ptr-obj path)) 812 (t 813 (ccl::value-for-kvo-key ptr-obj lisp-str)))) 814 (prev-class (class-of prev-obj)) 815 (new-lisp-obj (ns-to-lisp-object new-value :lisp-class prev-class)) 816 (setf-func (fboundp (list 'setf lisp-path))) 817 ;;`(setf (,lisp-path ,(lpw-lisp-ptr self)) ,new-lisp-obj)) 818 (ctrl (lpw-controller self))) 819 ;; (ns-log (format nil "Prev Class: ~s" prev-class)) 820 (cond (setf-func 821 (funcall setf-func new-lisp-obj ptr-obj)) 822 ((and (typep ptr-obj 'objc:objc-object) 823 (typep new-lisp-obj 'objc:objc-object) 824 (#/respondsToSelector: self (writer-selector lisp-str))) 825 (#/setValue:forKey: ptr-obj new-lisp-obj path)) 826 (t 827 (multiple-value-bind (value found-slot) 828 (setf (ccl::value-for-kvo-key ptr-obj lisp-str) new-lisp-obj) 829 (declare (ignore value)) 830 (if found-slot 831 (bound-slot-modified ptr-obj (ccl::slot-definition-name found-slot)) 832 ;; If the setf failed, log the original condition 833 (error "No way to setValue: ~s forKey: ~s for lisp-ptr ~s" 834 new-lisp-obj 835 lisp-str 836 ptr-obj))))) 837 (when ctrl 838 (lc::modified-bound-value ctrl 839 (lpw-lisp-ptr self) 840 lisp-path 841 prev-obj 842 new-lisp-obj)) 843 new-lisp-obj)) 738 (defun set-format-assoc (path-obj path format) 739 (setf (assoc-aref format-assoc path-obj path) format)) 740 741 (defun format-for (path-obj path) 742 (assoc-aref format-assoc path-obj path)) 844 743 845 744 ) 846 745 746 (objc:defmethod (#/addObserver:forKeyPath:options:context: :void) 747 ((self lisp-ptr-wrapper) (obs :id) (key-path :id) (options #>NSUInteger) (context :address)) 748 (let ((observer (real-observer obs))) 749 (ns-log (format nil "~s observed by ~s" (lpw-lisp-ptr self) observer)) 750 (when (subtypep (type-of observer) 'ns:ns-control) 751 (let* ((cell (#/cell observer)) 752 (formatter (#/formatter cell)) 753 (ns-format nil)) 754 (cond ((or (typep cell 'ns:ns-date-picker-cell) 755 (typep formatter 'ns:ns-date-formatter)) 756 (setf ns-format :date)) 757 ((typep formatter 'ns:ns-number-formatter) 758 (cond ((#/generatesDecimalNumbers formatter) 759 (let ((dec-digits (#/maximumFractionDigits formatter))) 760 (setf ns-format (list :decimal dec-digits)))) 761 (t 762 (setf ns-format :number))))) 763 (when ns-format 764 (ns-log (format nil "Observer data format: ~s" ns-format)) 765 (set-format-assoc self (ns-to-lisp-string key-path) ns-format))))) 766 (call-next-method obs key-path options context)) 767 768 (objc:defmethod (#/valueForKey: :id) 769 ((self lisp-ptr-wrapper) (path :id)) 770 ;; Treat path as a lisp path as long as it works. 771 ;; If it is not valid and the next target is an Objective-C object 772 ;; then treat the path as a normal Objective-C Key and return the results 773 ;; of calling #/valueForKey: on the target using path as the key. 774 (let* ((lisp-str (ns-to-lisp-string path)) 775 (lisp-path (objc-to-lisp-keypathname lisp-str)) 776 (ptr-obj (lpw-lisp-ptr self)) 777 ;; to set next-obj we try 3 ways: 778 ;; 1. If the path is a valid lisp function name use it to access the slot 779 ;; 2. If the object is an Objective-C object try calling its #/valueForKey method 780 ;; 3. Look for any KVO slots defined for the object with path specified as the KVO 781 ;; accessor and use the lisp function value-for-kvo-key to access that slot 782 (next-obj (cond ((and (typep lisp-path 'function-name) 783 (fboundp lisp-path)) 784 (funcall lisp-path ptr-obj)) 785 ((and (typep ptr-obj 'objc:objc-object) 786 (#/respondsToSelector: ptr-obj (reader-selector lisp-str))) 787 (#/valueForKey: ptr-obj path)) 788 (t 789 (ccl::value-for-kvo-key ptr-obj lisp-str))))) 790 ;; First track that the path is being observed by somebody 791 (note-kvc-observed self (lpw-lisp-ptr self) lisp-path) 792 (note-kvc-observed self (lpw-lisp-ptr self) lisp-str) 793 ;; (ns-log (format nil "(~s ~s) returned ~s" lisp-path (lpw-lisp-ptr self) next-obj)) 794 (cond ((eql next-obj (%null-ptr)) 795 next-obj) 796 ((null next-obj) 797 (%null-ptr)) 798 ((and (typep next-obj 'ns:ns-object) 799 (not (typep next-obj 'ccl::kvo-object))) 800 ;; any kvo-objects will be encapsulated in a lisp-ptr-wrapper 801 ;; so that subsequent accesses through this method will try to 802 ;; use ccl::value-for-kvo-key 803 next-obj) 804 ((typep next-obj 'objc-displayable) 805 (lisp-to-ns-object next-obj (format-for self lisp-str))) 806 (t 807 (wrapper-for (lpw-controller self) next-obj :parent (lpw-lisp-ptr self)))))) 808 809 (objc:defmethod (#/setValue:forKey: :void) 810 ((self lisp-ptr-wrapper) (new-value :id) (path :id)) 811 (let* ((lisp-str (ns-to-lisp-string path)) 812 (lisp-path (objc-to-lisp-keypathname lisp-str)) 813 (ptr-obj (lpw-lisp-ptr self)) 814 (prev-obj (cond ((and (typep lisp-path 'function-name) 815 (fboundp lisp-path)) 816 (funcall lisp-path ptr-obj)) 817 ((and (typep ptr-obj 'objc:objc-object) 818 (#/respondsToSelector: self (reader-selector lisp-str))) 819 (#/valueForKey: ptr-obj path)) 820 (t 821 (ccl::value-for-kvo-key ptr-obj lisp-str)))) 822 (prev-class (class-of prev-obj)) 823 (new-lisp-obj (ns-to-lisp-object new-value :lisp-class prev-class)) 824 (setf-func (fboundp (list 'setf lisp-path))) 825 ;;`(setf (,lisp-path ,(lpw-lisp-ptr self)) ,new-lisp-obj)) 826 (ctrl (lpw-controller self))) 827 ;; (ns-log (format nil "Prev Class: ~s" prev-class)) 828 (cond (setf-func 829 (funcall setf-func new-lisp-obj ptr-obj)) 830 ((and (typep ptr-obj 'objc:objc-object) 831 (typep new-lisp-obj 'objc:objc-object) 832 (#/respondsToSelector: self (writer-selector lisp-str))) 833 (#/setValue:forKey: ptr-obj new-lisp-obj path)) 834 (t 835 (multiple-value-bind (value found-slot) 836 (setf (ccl::value-for-kvo-key ptr-obj lisp-str) new-lisp-obj) 837 (declare (ignore value)) 838 (if found-slot 839 (bound-slot-modified ptr-obj (ccl::slot-definition-name found-slot)) 840 ;; If the setf failed, log the original condition 841 (error "No way to setValue: ~s forKey: ~s for lisp-ptr ~s" 842 new-lisp-obj 843 lisp-str 844 ptr-obj))))) 845 (when ctrl 846 (lc::modified-bound-value ctrl 847 (lpw-lisp-ptr self) 848 lisp-path 849 prev-obj 850 new-lisp-obj)) 851 new-lisp-obj)) 847 852 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 848 853 ;;; methods to support access to Lisp lists and arrays as if they were NSArrays
Note:
See TracChangeset
for help on using the changeset viewer.
