Changeset 14828


Ignore:
Timestamp:
Jun 15, 2011, 2:14:49 PM (8 years ago)
Author:
plkrueger
Message:

Interface bug fixes

Location:
trunk/cocoa-ide-contrib/krueger/InterfaceProjects
Files:
1 added
10 edited

Legend:

Unmodified
Added
Removed
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Cocoa Dev/lisp-app-doc.bundle/Contents/Resources/en.lproj/DevMenu.nib/designable.nib

    r14585 r14828  
    22<archive type="com.apple.InterfaceBuilder3.Cocoa.XIB" version="7.10">
    33        <data>
    4                 <int key="IBDocument.SystemTarget">1060</int>
     4                <int key="IBDocument.SystemTarget">1050</int>
    55                <string key="IBDocument.SystemVersion">10H574</string>
    66                <string key="IBDocument.InterfaceBuilderVersion">762</string>
     
    485485                                        <bool key="EncodedWithXMLCoder">YES</bool>
    486486                                        <string>com.apple.InterfaceBuilder.CocoaPlugin</string>
    487                                         <string>{{7, 512}, {279, 253}}</string>
     487                                        <string>{{43, 516}, {279, 253}}</string>
    488488                                        <string>com.apple.InterfaceBuilder.CocoaPlugin</string>
    489489                                        <string>com.apple.InterfaceBuilder.CocoaPlugin</string>
     
    628628                <int key="IBDocument.localizationMode">0</int>
    629629                <string key="IBDocument.TargetRuntimeIdentifier">IBCocoaFramework</string>
     630                <object class="NSMutableDictionary" key="IBDocument.PluginDeclaredDependencies">
     631                        <string key="NS.key.0">com.apple.InterfaceBuilder.CocoaPlugin.macosx</string>
     632                        <integer value="1050" key="NS.object.0"/>
     633                </object>
    630634                <object class="NSMutableDictionary" key="IBDocument.PluginDeclaredDevelopmentDependencies">
    631635                        <string key="NS.key.0">com.apple.InterfaceBuilder.CocoaPlugin.InterfaceBuilder3</string>
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Cocoa Dev/lisp-app-doc.lisp

    r14632 r14828  
    577577               (require (or (module-name app-main-source-res)
    578578                            (string-upcase (pathname-name app-main-source)))
    579                         app-main-source))
     579                        (pathname (full-path app-main-source-res))))
    580580           t)
    581581          ((plusp (length app-source-files))
    582582           (with-errors-alerted
    583583               (do-sequence (src-res app-source-files)
    584                             (unless (load (full-path src-res) :if-does-not-exist nil)
    585                               (alert :text (format nil "Source File ~s does not exist, not loaded" (full-path src-res))))))
     584                  (unless (load (full-path src-res) :if-does-not-exist nil)
     585                    (alert :text (format nil "Source File ~s does not exist, not loaded" (full-path src-res))))))
    586586           t)
    587587          (t
     
    770770(defmethod document-did-open ((self lisp-app-doc))
    771771  ;; Reload the Info.plist from whatever is in the bundle, if it exists
    772   (read-info-plist self))
     772  (read-info-plist self)
     773  ;; Check all the nib and source files to make sure they exist. Remove them if they don't.
     774  (let ((bad-nibs nil))
     775    (do-sequence (nib-res (app-nib-files self))
     776       (unless (probe-file (full-path nib-res))
     777         (push nib-res bad-nibs)))
     778    (dolist (nib-res bad-nibs)
     779      (delete-from-seq (app-nib-files self) nib-res)))
     780  (let ((bad-src nil))
     781    (do-sequence (src-res (app-source-files self))
     782     (unless (probe-file (full-path src-res))
     783       (push src-res bad-src)))
     784    (dolist (src-res bad-src)
     785      (delete-from-seq (app-nib-files self) src-res))))
    773786
    774787(defmethod window-will-close ((self lisp-app-doc))
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/alert.lisp

    r14585 r14828  
    2929(defpackage :interface-utilities
    3030  (:nicknames :iu)
     31  (:use :ccl :common-lisp)
    3132  (:export
    3233   alert
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/lisp-doc-controller.lisp

    r14585 r14828  
    103103      (setf (file-ext self) file-ext)
    104104      (setf (doc-ctrlr self) (#/sharedDocumentController ns:ns-document-controller))
    105       (setf (ldc-open-pnl self) (make-instance ns:ns-open-panel))
    106       (#/retain (ldc-open-pnl self))
     105      (setf (ldc-open-pnl self) (#/retain (make-instance ns:ns-open-panel)))
    107106      (setf (ext-ns-str self) (when file-ext (ccl::%make-nsstring file-ext)))
    108107      (when (ext-ns-str self)
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/ns-object-utils.lisp

    r14637 r14828  
    3333(defpackage :interface-utilities
    3434  (:nicknames :iu)
     35  (:use :ccl :common-lisp)
    3536  (:export
    3637   archive-slots
     
    4647   lisp-to-ns-array
    4748   lisp-to-ns-dict
     49   lisp-to-ns-func
    4850   lisp-to-ns-object
    4951   lisp-to-ns-misc
     
    5456   lpw-parent
    5557   make-ptr-wrapper
     58   ns-func
     59   ns-misc
     60   ns-sym
    5661   ns-to-lisp-array
    5762   ns-to-lisp-assoc
     
    6368   objc-to-lisp-sym
    6469   obj-if-not-null
    65    ns-misc
    66    ns-sym
    6770   objc-to-std-instance
    6871   print-ns-object
     
    8285  (require :alert)
    8386  (require :decimal)
    84   (require :assoc-array))
     87  (require :assoc-array)
     88  (require :attributed-strings))
    8589
    8690(in-package :iu)
     
    189193        ((typep ns-obj 'ns-misc)
    190194         (obj ns-obj))
     195        ((typep ns-obj 'ns-func)
     196         (func ns-obj))
    191197        ((typep ns-obj 'ns:ns-decimal-number)
    192198         (cond ((ccl::subclassp lisp-class (find-class 'double-float))
     
    247253           (ns-to-lisp-list ns-obj)
    248254           (ns-to-lisp-array ns-obj)))
     255        ((typep ns-obj 'ns:ns-attributed-string)
     256         (cond ((ccl::subclassp lisp-class (find-class 'string))
     257                (ns-attrib-to-lisp-string ns-obj))
     258               (t
     259                (make-instance 'attributed-string :ns-str ns-obj))))
    249260        ((typep ns-obj 'ns:ns-string)
    250261         (let ((lisp-str (ns-to-lisp-string ns-obj)))
     
    275286         ;; assume lisp-obj is an integer representing a lisp date
    276287         (lisp-to-ns-date lisp-obj))
     288        ((typep lisp-obj 'attributed-string)
     289         (cond ((eq ns-format :text)
     290                ;; The binding object doesn't accept NSAttributedStrings so
     291                ;; pass it an NSString
     292                (#/string (att-ns-str lisp-obj)))
     293               ((eq ns-format :archive)
     294                ;; We're archiving this to disk, so save it as we would
     295                ;; any other Lisp instance so that eq-ness is preserved when it is restored.
     296                (std-instance-to-objc lisp-obj))
     297               (t
     298                ;; Either null ns-format or :rich-text
     299                ;; Return the NSMutableAttributedString
     300                (att-ns-str lisp-obj))))
    277301        ((and (consp ns-format) (eq (first ns-format) :decimal))
    278302         (cond ((typep lisp-obj 'fixnum)
     
    311335         (lisp-to-ns-sym lisp-obj))
    312336        ((stringp lisp-obj)
    313          (lisp-to-temp-nsstring lisp-obj))
     337         (let ((ns-str (lisp-to-temp-nsstring lisp-obj)))
     338           (if (eq ns-format :rich-text)
     339             (#/autorelease (#/initWithString: (#/alloc ns:ns-attributed-string) ns-str))
     340             ns-str)))
    314341        ((hash-table-p lisp-obj)
    315342         (lisp-to-ns-dict lisp-obj))
     
    319346             (typep lisp-obj 'structure-object))
    320347         (std-instance-to-objc lisp-obj))
     348        ((typep lisp-obj 'function)
     349         (lisp-to-ns-func lisp-obj))
    321350        (t
    322351         (lisp-to-ns-misc lisp-obj))))
     
    414443  (or (converted-object obj)
    415444      (let* ((slots (archive-slots obj))
    416              (obj-dict (make-instance ns:ns-mutable-dictionary
    417                          :with-capacity (1+ (* 2 (list-length slots)))))
    418              (obj-ref (make-instance 'lisp-object-reference :obj-dict obj-dict)))       
     445             (obj-dict (#/dictionaryWithCapacity: ns:ns-mutable-dictionary (1+ (* 2 (list-length slots)))))
     446             (obj-ref (make-instance 'lisp-object-reference :obj-dict obj-dict)))
    419447        (note-converted-object obj obj-ref)
    420448        (#/setObject:forKey: obj-dict
     
    430458                                                                     "__class__")))
    431459            (#/setObject:forKey: obj-dict
    432                                  (lisp-to-ns-object slot-val)
     460                                 (lisp-to-ns-object slot-val :archive)
    433461                                 (lisp-to-temp-nsstring slot-str))))
    434462        (#/autorelease obj-ref))))
     
    766794(objc:defmethod (#/addObserver:forKeyPath:options:context: :void)
    767795                ((self lisp-ptr-wrapper) (obs :id) (key-path :id) (options #>NSUInteger) (context :address))
    768   (let ((observer (real-observer obs)))
     796  (let ((observer (real-observer obs))
     797        (ns-format nil))
    769798    ;; (ns-log (format nil "~s observed by ~s" (lpw-lisp-ptr self) observer))
    770     (when (subtypep (type-of observer) 'ns:ns-control)
    771       (let* ((cell (#/cell observer))
    772              (formatter (#/formatter cell))
    773              (ns-format nil))
    774         (cond ((or (typep cell 'ns:ns-date-picker-cell)
    775                    (typep formatter 'ns:ns-date-formatter))
    776                (setf ns-format :date))
    777               ((typep formatter 'ns:ns-number-formatter)
    778                (cond ((#/generatesDecimalNumbers formatter)
    779                       (let ((dec-digits (#/maximumFractionDigits formatter)))
    780                         (setf ns-format (list :decimal dec-digits))))
    781                      (t
    782                       (setf ns-format :number)))))
    783         (when ns-format
    784           ;; (ns-log (format nil "Observer data format: ~s" ns-format))
    785           (set-format-assoc self (ns-to-lisp-string key-path) ns-format)
    786           ;; We use the ns-format as a hint about how the lisp field is
    787           ;; formatted and convert accordingly when that value is retrieved.
    788           ;; Any controls that previously observed this field might have
    789           ;; received misformatted data, so indicate that the data changed
    790           ;; so they will go get it again. This primarily occurs when a new
    791           ;; window is open and controls are first observing the field.
    792           (#/willChangeValueForKey: self key-path)
    793           (#/didChangeValueForKey: self key-path)))))
     799    (cond ((typep observer 'ns:ns-control)
     800           (let* ((cell (#/cell observer))
     801                  (formatter (#/formatter cell)))
     802             (cond ((or (typep cell 'ns:ns-date-picker-cell)
     803                        (typep formatter 'ns:ns-date-formatter))
     804                    (setf ns-format :date))
     805                   ((typep formatter 'ns:ns-number-formatter)
     806                    (cond ((#/generatesDecimalNumbers formatter)
     807                           (let ((dec-digits (#/maximumFractionDigits formatter)))
     808                             (setf ns-format (list :decimal dec-digits))))
     809                          (t
     810                           (setf ns-format :number))))
     811                   (t
     812                    ;; NSControls can always accept NSAttributedStrings
     813                    (setf ns-format :rich-text)))))
     814          ((typep observer 'ns:ns-text)
     815           ;; This is a little tricky becasue NSText objects can bind to either
     816           ;; an NSAttributedString or to an NSString via separate bindings.
     817           ;; But we have no real way of knowing which they bound to in IB, so
     818           ;; we guess based on the value returned by #/isRichText. Also the
     819           ;; developer gives us a hint by what sort of object is in the slot that
     820           ;; the interface object is bound to. If that slot has a lisp attributed-string
     821           ;; object and the field allows rich-text, we'll pass it an NSMutableAttributedString.
     822           ;; Otherwise it will just get an NSString.
     823           (setf ns-format (if (#/isRichText observer)
     824                             :rich-text
     825                             :text))))
     826    (when ns-format
     827      ;; (ns-log (format nil "Observer data format: ~s" ns-format))
     828      (set-format-assoc self (ns-to-lisp-string key-path) ns-format)
     829      ;; We use the ns-format as a hint about how the lisp field is
     830      ;; formatted and convert accordingly when that value is retrieved.
     831      ;; Any controls that previously observed this field might have
     832      ;; received misformatted data, so indicate that the data changed
     833      ;; so they will go get it again. This primarily occurs when a new
     834      ;; window is open and controls are first observing the field.
     835      (#/willChangeValueForKey: self key-path)
     836      (#/didChangeValueForKey: self key-path)))
    794837  (call-next-method obs key-path options context))
    795838
     
    9851028
    9861029(defmethod lisp-to-ns-sym ((sym symbol))
    987   (make-instance 'ns-sym :sym sym))
     1030  (#/autorelease (make-instance 'ns-sym :sym sym)))
     1031
     1032;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     1033;; Methods dealing with conversion of lisp functions
     1034;;
     1035;; We save the function name so that it can be reconstituted when loaded back
     1036
     1037(defclass ns-func (ns:ns-object)
     1038  ((func :accessor func :initarg :func)
     1039   (ns-str :accessor ns-str)
     1040   (func-name :accessor func-name)
     1041   (func-package :accessor func-package))
     1042  (:metaclass ns:+ns-object))
     1043
     1044(defmethod initialize-instance :after ((self ns-func) &key func &allow-other-keys)
     1045  (setf (func-name self) (function-name func))
     1046  (setf (func-package self) (symbol-package (func-name self)))
     1047  (setf (ns-str self) (ccl::%make-nsstring (print-object self nil))))
     1048
     1049(defmethod print-object ((self ns-func) strm)
     1050  (format strm "(function ~a::~a)" (package-name (func-package self)) (func-name self)))
     1051
     1052(objc:defmethod (#/dealloc :void)
     1053                ((self ns-func))
     1054  (#/release (ns-str self))
     1055  (call-next-method))
     1056
     1057;; This method suffices to make an ns-func act like an NSString if the runtime is 10.6 or higher
     1058(objc:defmethod (#/forwardingTargetForSelector: :id)
     1059                ((self ns-func) (sel #>SEL))
     1060  (ns-str self))
     1061
     1062;; Otherwise the following two methods are needed
     1063
     1064(objc:defmethod (#/methodSignatureForSelector: :id)
     1065                ((self ns-func) (sel #>SEL))
     1066  (#/methodSignatureForSelector: (ns-str self) sel))
     1067
     1068(objc:defmethod (#/forwardInvocation: :void)
     1069                ((self ns-func) (inv :id))
     1070  (#/invokeWithTarget: inv (ns-str self)))
     1071
     1072(objc:defmethod (#/initWithCoder: :id)
     1073                ((self ns-func) (decoder :id))
     1074  (let* ((func-name (#/decodeObjectForKey: decoder #@"funcName"))
     1075         (func-pkg (#/decodeObjectForKey: decoder #@"funcPkg"))
     1076         (pkg-str (ns-to-lisp-string func-pkg)))
     1077    (setf (func-name self) (ns-to-lisp-string func-name))
     1078    (setf (func-package self) (or (find-package pkg-str)
     1079                                  (make-package pkg-str)))
     1080    (setf (func self) (symbol-function (intern (func-name self) (func-package self))))
     1081    (setf (ns-str self) (ccl::%make-nsstring (print-object self nil)))
     1082    self))
     1083
     1084(objc:defmethod (#/encodeWithCoder: :void)
     1085                ((self ns-func) (coder :id))
     1086  (#/encodeObject:forKey: coder
     1087                          (lisp-to-temp-nsstring (func-name self))
     1088                          #@"funcName")
     1089  (#/encodeObject:forKey: coder
     1090                          (lisp-to-temp-nsstring (package-name (func-package self)))
     1091                          #@"funcPkg"))
     1092
     1093(defmethod lisp-to-ns-func ((func function))
     1094  (#/autorelease (make-instance 'ns-func :func func)))
     1095
    9881096
    9891097;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    10181126
    10191127(objc:defmethod (#/methodSignatureForSelector: :id)
    1020                 ((self ns-sym) (sel #>SEL))
     1128                ((self ns-misc) (sel #>SEL))
    10211129  (#/methodSignatureForSelector: (ns-str self) sel))
    10221130
    10231131(objc:defmethod (#/forwardInvocation: :void)
    1024                 ((self ns-sym) (inv :id))
     1132                ((self ns-misc) (inv :id))
    10251133  (#/invokeWithTarget: inv (ns-str self)))
    10261134
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/ns-string-utils.lisp

    r14585 r14828  
    4343(defun ns-to-lisp-string (ns-str)
    4444  (if (and (not (eql (%null-ptr) ns-str)) (plusp (#/length ns-str)))
    45     (%get-cstring (#/cStringUsingEncoding: ns-str #$NSUTF8StringEncoding))
     45    (ccl::%get-utf-8-cstring (#/UTF8String ns-str))
    4646    ""))
     47
     48(defun ns-attrib-to-lisp-string (att-str)
     49  (ns-to-lisp-string (#/string att-str)))
    4750
    4851(defun non-empty-string (str)
     
    113116        t))))
    114117
     118(defun make-mutable-nsstring (string)
     119  (with-encoded-cstrs :utf-8 ((s string))
     120    (#/initWithUTF8String: (#/alloc ns:ns-mutable-string) s)))
     121
     122
     123
    115124(provide :ns-string-utils)
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/quick-window.lisp

    r14585 r14828  
    3939                               (resizeable nil)
    4040                               (miniaturizable t)
    41                                (text nil)
     41                               (editable-text nil)
     42                               (text "Quick Window Text")
    4243                               (width 190)
    4344                               (height 60)
     
    5253                 (if miniaturizable #$NSMiniaturizableWindowMask 0))
    5354              #$NSBackingStoreBuffered
    54               #$NO)))
     55              #$NO))
     56        (label (#/initWithFrame: (#/alloc ns:ns-text-view) (ns:make-ns-rect 0 0 (- width 5) (- height 20)))))
    5557    (when (and titled title)
    5658      (#/setTitle: win (lisp-to-temp-nsstring title)))
    5759    (if content-view
    5860      (#/setContentView: win content-view)
    59       (when text
    60         (let ((label (#/initWithFrame: (#/alloc ns:ns-text-view) (ns:make-ns-rect 0 0 185 40))))
    61           (#/insertText: label (lisp-to-temp-nsstring text))
    62           (#/setEditable: label #$NO)
    63           (#/setContentView: win label)
    64           (#/autorelease label))))
    65     (#/autorelease win)))
     61      (progn
     62        ;; text argument can be either a string or attributed-string instance
     63        (#/setAttributedString: (#/textStorage label) (lisp-to-ns-object text :rich-text))
     64        (#/setEditable: label (if editable-text #$YES #$NO))
     65        (#/setContentView: win label)))
     66    (#/autorelease label)
     67    (values (#/autorelease win)
     68            (or content-view label))))
     69
     70(defun show-quick-window (win)
     71  (let ((wc (#/initWithWindow: (#/alloc ns:ns-window-controller) win)))
     72    (#/showWindow: wc (%null-ptr))
     73    wc))
    6674
    6775(provide :quick-window)
  • trunk/cocoa-ide-contrib/krueger/InterfaceProjects/Utilities/utility.lisp

    r14585 r14828  
    2525(defpackage :interface-utilities
    2626  (:nicknames :iu)
    27   (:export do-sequence))
     27  (:export
     28   delete-from-seq
     29   do-sequence))
    2830
    2931(in-package :iu)
     
    3436       (let ((,seq-elt (elt ,seq ,seq-indx)))
    3537         ,@body))))
     38
     39(defmethod delete-from-seq ((seq vector) thing)
     40  (let ((pos (position thing seq)))
     41    (dotimes (i (- (fill-pointer seq) pos 1))
     42      (setf (aref seq (+ pos i))
     43            (aref seq (+ pos i 1)))))
     44  (vector-pop seq))
Note: See TracChangeset for help on using the changeset viewer.