Changeset 16204


Ignore:
Timestamp:
Sep 17, 2014, 6:11:11 PM (7 years ago)
Author:
plkrueger
Message:

Bug Fixes to Cocoa Tools contrib

Location:
trunk/cocoa-ide-contrib/krueger/InterfaceProjects
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Squiggle/squiggle-doc.lisp

    r15808 r16204  
    189189                 :align :center-y)
    190190
    191     ;; Set up things so that the squiggle doc gets notifid when the window's frame changes size so
     191    ;; Set up things so that the squiggle doc gets notified when the window's frame changes size so
    192192    ;; that it can save that value off and restore it when a squiggle-doc is reopened.
    193193    (setf (notif-handler doc) (make-instance 'notification-handler
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/ns-object-utils.lisp

    r16202 r16204  
    7070    nil
    7171    ns-obj))
     72
     73(defun retain-if-necessary (obj)
     74  (when (and *unconverting* (ccl::objc-object-p obj)
     75             (#/retain obj)))
     76  obj)
    7277
    7378(defun unreadable-object-string-p (str)
     
    150155  (when *debug-convert*
    151156    (ns-log-format "Converting ~s to lisp~@[ lisp-class = ~s~]~@[ ns-format = ~s~]" ns-obj lisp-class ns-format))
    152   (cond ((ccl::subclassp (class-of ns-obj) lisp-class)
    153          ;; ns-obj is a subclass of the target lisp class so just return the new value
    154          ns-obj)
    155         ((or (eql ns-obj (%null-ptr))
    156              (eql ns-obj #$NSNoSelectionMarker)
    157              (eql ns-obj #$NSNullPlaceholderBindingOption)
    158              (eql ns-obj #$NSNotApplicablePlaceholderBindingOption))
    159          (if (ccl::subclassp lisp-class (find-class 'string))
    160            ""
    161            nil))
    162         ((typep ns-obj 'lisp-ptr-wrapper)
    163          ;; just strip the wrapper and return the original object
    164          (lpw-lisp-ptr ns-obj))
    165         ((typep ns-obj 'ns-sym)
    166          (sym ns-obj))
    167         ((typep ns-obj 'ns-misc)
    168          (obj ns-obj))
    169         ((typep ns-obj 'ns-func)
    170          (func ns-obj))
    171         ((typep ns-obj 'ns:ns-decimal-number)
    172          (cond ((ccl::subclassp lisp-class (find-class 'double-float))
    173                 ;; convert the decimal to a double
    174                 (#/doubleValue ns-obj))
    175                ((ccl::subclassp lisp-class (find-class 'float))
    176                 ;; convert the decimal to a float
    177                 (#/floatValue ns-obj))
    178                (t
    179                 ;; otherwise convert it to an appropriate lisp integer with assumed
    180                 ;; decimals (see ip;Utilities;decimal.lisp)
    181                 (if (and (listp ns-format) (eq (first ns-format) :decimal))
    182                   (lisp-from-ns-decimal ns-obj :decimals (second ns-format))
    183                   (lisp-from-ns-decimal ns-obj)))))
    184         ((typep ns-obj 'ns:ns-url)
    185          (ns-to-lisp-string (if (#/isFileURL ns-obj)
    186                               (#/path ns-obj)
    187                               (#/absoluteString ns-obj))))
    188         ((typep ns-obj 'ns:ns-number)
    189          (cond ((and (listp ns-format) (eq (first ns-format) :decimal))
    190                 (round (* (expt 10 (second ns-format)) (#/floatValue ns-obj))))
    191                ((eq lisp-class (find-class 'symbol))
    192                 ;; how can a number be of class 'symbol? Simple, it is nil if number
    193                 ;; is 0 or t otherwise
    194                 (not (= (#/intValue ns-obj) 0)))
    195                ((ccl::subclassp lisp-class (find-class 'double-float))
    196                 ;; convert the number to a double
    197                 (#/doubleValue ns-obj))
    198                ((ccl::subclassp lisp-class (find-class 'float))
    199                 ;; convert the number to a float
    200                 (#/floatValue ns-obj))
    201                ((ccl::subclassp lisp-class (find-class 'integer))
    202                 ;; convert the number to an integer
    203                 (#/longLongValue ns-obj))
    204                ((ccl::subclassp lisp-class (find-class 'ratio))
    205                 ;; convert the number to an integer
    206                 (#/floatValue ns-obj))
    207                ((eql ns-obj (#/numberWithBool: ns:ns-number #$YES))
    208                 ;; the number is the constant for #$YES, convert to t
    209                 ;; This does NOT convert all numbers with the value 1 to t
    210                 t)
    211                ((eql ns-obj (#/numberWithBool: ns:ns-number #$NO))
    212                 ;; the number is the constant for #$NO, convert to nil
    213                 ;; This does NOT convert all numbers with the value 0 to nil
    214                 nil)
    215                (t
    216                 ;; no specific target, so just read from the string representation
    217                 (read-from-string (ns-to-lisp-string
    218                                    (#/descriptionWithLocale: ns-obj (%null-ptr)))
    219                                   nil nil))))
    220         ((typep ns-obj 'ns:ns-date)
    221          (ns-to-lisp-date ns-obj))
    222         ((typep ns-obj 'lisp-object-reference)
    223          (objc-to-std-instance ns-obj))
    224         ((typep ns-obj 'ns:ns-dictionary)
    225          (cond ((ccl::subclassp lisp-class (find-class 'list))
    226                 (ns-to-lisp-assoc ns-obj))
    227                (t
    228                 (ns-to-lisp-hash-table ns-obj))))
    229         ((typep ns-obj 'ns:ns-array)
    230          (if (or (ccl::subclassp lisp-class (find-class 'list))
    231                  (eq lisp-class (find-class 'null))) ;; assume they want a list
    232            (ns-to-lisp-list ns-obj)
    233            (ns-to-lisp-array ns-obj)))
    234         ((typep ns-obj 'ns:ns-attributed-string)
    235          (cond ((ccl::subclassp lisp-class (find-class 'string))
    236                 (ns-attrib-to-lisp-string ns-obj))
    237                (t
    238                 (make-instance 'attributed-string :ns-str ns-obj))))
    239         ((typep ns-obj 'ns:ns-string)
    240          (let ((lisp-str (ns-to-lisp-string ns-obj)))
    241            (cond ((ccl::subclassp lisp-class (find-class 'string))
    242                   lisp-str)
    243                  ((ccl::subclassp lisp-class (find-class 'symbol))
    244                   (string-to-interned-symbol lisp-str))
    245                  ((ccl::subclassp lisp-class (find-class 'number))
    246                   (let ((num (read-from-string lisp-str :nil 0)))
    247                     (if (numberp num)
    248                       num
    249                       lisp-str)))
    250                  (t
    251                   lisp-str))))
    252         ((typep ns-obj 'ns:ns-null)
    253          nil)
    254         (t
    255          ;; can't convert so just return ns-obj
    256          ns-obj)))
     157  (retain-if-necessary
     158   (cond ((ccl::subclassp (class-of ns-obj) lisp-class)
     159          ;; ns-obj is a subclass of the target lisp class so just return the new value
     160          ns-obj)
     161         ((or (eql ns-obj (%null-ptr))
     162              (eql ns-obj #$NSNoSelectionMarker)
     163              (eql ns-obj #$NSNullPlaceholderBindingOption)
     164              (eql ns-obj #$NSNotApplicablePlaceholderBindingOption))
     165          (if (ccl::subclassp lisp-class (find-class 'string))
     166              ""
     167              nil))
     168         ((typep ns-obj 'lisp-ptr-wrapper)
     169          ;; just strip the wrapper and return the original object
     170          (lpw-lisp-ptr ns-obj))
     171         ((typep ns-obj 'ns-sym)
     172          (sym ns-obj))
     173         ((typep ns-obj 'ns-misc)
     174          (obj ns-obj))
     175         ((typep ns-obj 'ns-func)
     176          (func ns-obj))
     177         ((typep ns-obj 'ns:ns-decimal-number)
     178          (cond ((ccl::subclassp lisp-class (find-class 'double-float))
     179                 ;; convert the decimal to a double
     180                 (#/doubleValue ns-obj))
     181                ((ccl::subclassp lisp-class (find-class 'float))
     182                 ;; convert the decimal to a float
     183                 (#/floatValue ns-obj))
     184                (t
     185                 ;; otherwise convert it to an appropriate lisp integer with assumed
     186                 ;; decimals (see ip;Utilities;decimal.lisp)
     187                 (if (and (listp ns-format) (eq (first ns-format) :decimal))
     188                     (lisp-from-ns-decimal ns-obj :decimals (second ns-format))
     189                     (lisp-from-ns-decimal ns-obj)))))
     190         ((typep ns-obj 'ns:ns-url)
     191          (ns-to-lisp-string (if (#/isFileURL ns-obj)
     192                                 (#/path ns-obj)
     193                                 (#/absoluteString ns-obj))))
     194         ((typep ns-obj 'ns:ns-number)
     195          (cond ((and (listp ns-format) (eq (first ns-format) :decimal))
     196                 (round (* (expt 10 (second ns-format)) (#/floatValue ns-obj))))
     197                ((eq lisp-class (find-class 'symbol))
     198                 ;; how can a number be of class 'symbol? Simple, it is nil if number
     199                 ;; is 0 or t otherwise
     200                 (not (= (#/intValue ns-obj) 0)))
     201                ((ccl::subclassp lisp-class (find-class 'double-float))
     202                 ;; convert the number to a double
     203                 (#/doubleValue ns-obj))
     204                ((ccl::subclassp lisp-class (find-class 'float))
     205                 ;; convert the number to a float
     206                 (#/floatValue ns-obj))
     207                ((ccl::subclassp lisp-class (find-class 'integer))
     208                 ;; convert the number to an integer
     209                 (#/longLongValue ns-obj))
     210                ((ccl::subclassp lisp-class (find-class 'ratio))
     211                 ;; convert the number to an integer
     212                 (#/floatValue ns-obj))
     213                ((eql ns-obj (#/numberWithBool: ns:ns-number #$YES))
     214                 ;; the number is the constant for #$YES, convert to t
     215                 ;; This does NOT convert all numbers with the value 1 to t
     216                 t)
     217                ((eql ns-obj (#/numberWithBool: ns:ns-number #$NO))
     218                 ;; the number is the constant for #$NO, convert to nil
     219                 ;; This does NOT convert all numbers with the value 0 to nil
     220                 nil)
     221                (t
     222                 ;; no specific target, so just read from the string representation
     223                 (read-from-string (ns-to-lisp-string
     224                                    (#/descriptionWithLocale: ns-obj (%null-ptr)))
     225                                   nil nil))))
     226         ((typep ns-obj 'ns:ns-date)
     227          (ns-to-lisp-date ns-obj))
     228         ((typep ns-obj 'lisp-object-reference)
     229          (objc-to-std-instance ns-obj))
     230         ((typep ns-obj 'ns:ns-dictionary)
     231          (cond ((ccl::subclassp lisp-class (find-class 'list))
     232                 (ns-to-lisp-assoc ns-obj))
     233                (t
     234                 (ns-to-lisp-hash-table ns-obj))))
     235         ((typep ns-obj 'ns:ns-array)
     236          (if (or (ccl::subclassp lisp-class (find-class 'list))
     237                  (eq lisp-class (find-class 'null))) ;; assume they want a list
     238              (ns-to-lisp-list ns-obj)
     239              (ns-to-lisp-array ns-obj)))
     240         ((typep ns-obj 'ns:ns-attributed-string)
     241          (cond ((ccl::subclassp lisp-class (find-class 'string))
     242                 (ns-attrib-to-lisp-string ns-obj))
     243                (t
     244                 (make-instance 'attributed-string :ns-str ns-obj))))
     245         ((typep ns-obj 'ns:ns-string)
     246          (let ((lisp-str (ns-to-lisp-string ns-obj)))
     247            (cond ((ccl::subclassp lisp-class (find-class 'string))
     248                   lisp-str)
     249                  ((ccl::subclassp lisp-class (find-class 'symbol))
     250                   (string-to-interned-symbol lisp-str))
     251                  ((ccl::subclassp lisp-class (find-class 'number))
     252                   (let ((num (read-from-string lisp-str :nil 0)))
     253                     (if (numberp num)
     254                         num
     255                         lisp-str)))
     256                  (t
     257                   lisp-str))))
     258         ((typep ns-obj 'ns:ns-null)
     259          nil)
     260         (t
     261          ;; can't convert so just return ns-obj
     262          ns-obj))))
    257263
    258264(defun lisp-to-ns-object (lisp-obj &optional (ns-format nil))
     
    519525                   (slot-class (find-class slot-class-str nil))
    520526                   (objc-slot-val (#/objectForKey: obj-dict (lisp-to-temp-nsstring slot-str)))
     527                   (*retain-objc-objects* t)
    521528                   (slot-val (ns-to-lisp-object
    522529                              objc-slot-val
    523530                              :lisp-class slot-class)))
    524               (when (ccl::objc-object-p slot-val)
    525                 (#/retain slot-val))
    526531              (cond ((eq slot-val :none)
    527532                     (ns-log (format nil
Note: See TracChangeset for help on using the changeset viewer.