Changeset 6130


Ignore:
Timestamp:
Apr 4, 2007, 4:03:32 AM (13 years ago)
Author:
gb
Message:

Use MAKE-INSTANCE vice MAKE-OBJC-INSTANCE in example code.
Try to avoid SLET, SEND, DEFINE-OBJC-METHOD.
Demo IDE "works" (modulo backtrace) on x86-64 Leopard, bridge
still needs work on PPC.

Location:
branches/objc-gf/ccl/examples
Files:
16 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/examples/bridge.lisp

    r6112 r6130  
    244244  (y ns::ns-rect-y :<NSR>ect.origin.y wrap-cg-float)
    245245  (width ns::ns-rect-width :<NSR>ect.size.width wrap-cg-float)
    246   (height ns::ns-rect-height :<NSR>ect.size.width wrap-cg-float))
     246  (height ns::ns-rect-height :<NSR>ect.size.height wrap-cg-float))
    247247
    248248
     
    323323     
    324324
    325 (setf (pkg.intern-hook (find-package "NS"))
     325(setf (pkg.intern-hook (find-package "NSFUN"))
    326326      'get-objc-message-info)
    327327
     
    343343                                      (signal-reader-error stream "Invalid token after #/."))
    344344                                    (check-objc-message-name token)
    345                                     (intern token "NS")))))
     345                                    (intern token "NSFUN")))))
    346346
    347347
     
    735735        (format stream "~s" name)))))
    736736
    737 (declaim (inline check-receiever))
     737
     738
     739
     740(declaim (inline check-receiver))
    738741
    739742;;; Return a NULL pointer if RECEIVER is a null pointer.
     
    10251028  (let* ((info (get-objc-message-info message-name)))
    10261029    (unless info
     1030      (format *error-output* "~&; Note: defining new ObjC message ~c[~a ~a]" (if class-p #\+ #\-) class-name message-name)
    10271031      (setq info (make-objc-message-info :message-name message-name))
    10281032      (setf (gethash message-name *objc-message-info*) info))
     
    13411345  (multiple-value-bind (ks vs) (keys-and-vals initargs)
    13421346    (declare (dynamic-extent ks vs))
    1343     (when (not (stringp cname))
    1344       (setf cname (lisp-to-objc-classname cname)))
    1345     (send-objc-init-message (send (find-objc-class cname) 'alloc)
    1346                             ks
    1347                             vs)))
     1347    (let* ((class (etypecase cname
     1348                    (string (canonicalize-registered-class
     1349                             (find-objc-class cname)))
     1350                    (symbol (find-class cname))
     1351                    (class cname))))
     1352      (send-objc-init-message (#/alloc class) ks vs))))
    13481353
    13491354;;; Provide the BRIDGE module
  • branches/objc-gf/ccl/examples/cocoa-application.lisp

    r4790 r6130  
    3535  (or (getenv "CCL_DEFAULT_DIRECTORY")
    3636      (with-autorelease-pool
    37           (let* ((bundle (send (@class ns-bundle) 'main-bundle))
     37          (let* ((bundle (#/mainBundle ns:ns-bundle))
    3838                 (ccl-dir (unless (%null-ptr-p bundle)
    39                             (send bundle :object-for-info-dictionary-key
     39                            (#/objectForInfoDictionaryKey: bundle
    4040                                  #@"CCLDefaultDirectory")))
    4141                 (bundle-path (unless (%null-ptr-p bundle)
    42                                 (send bundle 'bundle-path))))
     42                                (#/bundlePath bundle))))
    4343            (when (and ccl-dir (not (%null-ptr-p ccl-dir))
    4444                       bundle-path (not (%null-ptr-p bundle-path)))
  • branches/objc-gf/ccl/examples/cocoa-backtrace.lisp

    r6112 r6130  
    3434  #@"backtrace")
    3535
    36 (define-objc-method ((:void close)
    37                      backtrace-window-controller)
     36(objc:defmethod (#/close :void) ((self backtrace-window-controller))
    3837  (setf (slot-value self 'context) nil)
    39   (send-super 'close))
     38  (call-next-method))
    4039
    4140(defmethod our-frame-label-p ((self backtrace-window-controller) thing)
     
    166165#+debug
    167166(objc:defmethod (#/willLoad :void) ((self backtrace-window-controller))
    168   (#_NSLog #@"will load %@" :address ) #/windowNibName self))
     167  (#_NSLog #@"will load %@" :address  (#/windowNibName self)))
    169168
    170169(defmethod ui-object-enter-backtrace-context ((app ns:ns-application)
     
    183182        (let* ((window (bt.dialog context)))
    184183          (when window
    185             (send window
    186                   :perform-selector-on-main-thread
    187                   (@selector "close")
    188                   :with-object (%null-ptr)
    189                   :wait-until-done t)))))))
     184            (#/performSelectorOnMainThread:withObject:waitUntilDone: window (@selector @/close)  +null-ptr+ t)))))))
    190185
    191186 
  • branches/objc-gf/ccl/examples/cocoa-editor.lisp

    r6112 r6130  
    1 ;;;-*- Mode: LISP; Package: CCL -*-
     1;;-*- Mode: LISP; Package: CCL -*-
    22
    33
     
    275275;;; Return the character at the specified index (as a :unichar.)
    276276
    277 (objc:defmethod (#/characterAtIndex :unichar)
     277(objc:defmethod (#/characterAtIndex: :unichar)
    278278    ((self hemlock-buffer-string) (index :<NSUI>nteger))
    279279  #+debug
     
    284284    ((self hemlock-buffer-string)
    285285     (buffer (:* :unichar))
    286      (r (:<NSR>ange)))
     286     (r :<NSR>ange))
    287287  (let* ((cache (hemlock-buffer-string-cache self))
    288288         (index (ns:ns-range-location r))
     
    320320         (hi::*buffer-gap-context*
    321321          (hi::buffer-gap-context (buffer-cache-buffer cache))))
    322     #+debug 0
     322    #+debug
    323323    (#_NSLog #@"get line start: %d/%d"
    324324             :unsigned index
     
    361361    (hi::%set-buffer-modified buffer nil)
    362362    (if (eql 0 raw-length)
    363       (make-objc-instance 'ns:ns-mutable-data :with-length 0)
     363      (make-instance 'ns:ns-mutable-data :with-length 0)
    364364      (case external-format
    365365        ((:unix nil)
     
    377377               (when next (incf raw-length))))
    378378           (let* ((pos 0)
    379                   (data (make-objc-instance 'ns:ns-mutable-data
    380                                             :with-length raw-length))
     379                  (data (make-instance 'ns:ns-mutable-data
     380                                       :with-length raw-length))
    381381                  (bytes (#/mutableBytes data)))
    382382             (do* ((line (hi::mark-line (hi::buffer-start-mark buffer))
     
    435435(defun textstorage-note-insertion-at-position (self pos n)
    436436  (rlet ((r :ns-range))
    437     (ns:init-ns-range pos 0)
     437    (ns:init-ns-range r pos 0)
    438438    (#/edited:range:changeInLength: self #$NSTextStorageEditedAttributes r n)
    439439    (setf (ns:ns-range-length r) n)
     
    441441
    442442(objc:defmethod (#/noteInsertion: :void) ((self hemlock-text-storage) params)
    443   (let* ((pos (#/intValue (#/objectAtIndex: params 0)))
    444          (n (#/intValue (#/objectAtIndex: params 1))))
     443  (let* ((pos (#/longValue (#/objectAtIndex: params 0)))
     444         (n (#/longValue (#/objectAtIndex: params 1))))
    445445    (textstorage-note-insertion-at-position self pos n)))
    446446
    447447(objc:defmethod (#/noteDeletion: :void) ((self hemlock-text-storage) params)
    448   (let* ((pos (#/intValue (#/objectAtIndex: params 0)))
    449          (n (#/intValue (#/objectAtIndex: params 1))))
     448  (let* ((pos (#/longValue (#/objectAtIndex: params 0)))
     449         (n (#/longValue (#/objectAtIndex: params 1))))
    450450    (rlet ((range :ns-range :location pos :length n))
    451       (#/edited:range:changeInLength: self #$NSTextStorageEditedCharacters r (- n)))
     451      (#/edited:range:changeInLength: self #$NSTextStorageEditedCharacters range (- n)))
    452452    (let* ((display (hemlock-buffer-string-cache (#/string self))))
    453453      (reset-buffer-cache display)
     
    455455
    456456(objc:defmethod (#/noteModification: :void) ((self hemlock-text-storage) params)
    457   (let* ((pos (#/intValue (#/objectAtIndex: params 0)))
    458          (n (#/intValue (#/objectAtIndex: params 1))))
     457  (let* ((pos (#/longValue (#/objectAtIndex: params 0)))
     458         (n (#/longValue (#/objectAtIndex: params 1))))
    459459    #+debug
    460460    (#_NSLog #@"Note modification: pos = %d, n = %d" :int pos :int n)
     
    463463                                                  #$NSTextStorageEditedAttributes) range 0))))
    464464
    465 (objc:defmethod (#/noteAttrChange :void) ((self hemlock-text-storage) params)
    466   (let* ((pos (#/intValue (#/objectAtIndex: params 0)))
    467          (n (#/intValue (#/objectAtIndex: params 1))))
     465(objc:defmethod (#/noteAttrChange: :void) ((self hemlock-text-storage) params)
     466  (let* ((pos (#/longValue (#/objectAtIndex: params 0)))
     467         (n (#/longValue (#/objectAtIndex: params 1))))
    468468    #+debug (#_NSLog #@"attribute-change at %d/%d" :int pos :int n)
    469469    (rlet ((range :ns-range :location pos :length n))
     
    498498
    499499(objc:defmethod #/initWithString: ((self hemlock-text-storage) s)
    500   (let* ((newself (call-next-method)))
     500  (let* ((newself (#/init self)))
    501501    (setf (slot-value newself 'string) s)
    502502    newself))
     
    506506;;; hemlock-buffer-string.)
    507507(defun make-textstorage-for-hemlock-buffer (buffer)
    508   (make-objc-instance 'hemlock-text-storage
    509                       :with-string
    510                       (make-instance
    511                        'hemlock-buffer-string
    512                        :cache
    513                        (reset-buffer-cache
    514                         (make-buffer-cache)
    515                         buffer))))
    516 
    517 (define-objc-method ((:id :attributes-at-index (:<NSUI>nteger index)
    518                           :effective-range ((* :<NSR>ange) rangeptr))
    519                      hemlock-text-storage)
     508  (make-instance 'hemlock-text-storage
     509                 :with-string
     510                 (make-instance
     511                  'hemlock-buffer-string
     512                  :cache
     513                  (reset-buffer-cache
     514                   (make-buffer-cache)
     515                   buffer))))
     516
     517(objc:defmethod #/attributesAtIndex:effectiveRange:
     518    ((self hemlock-text-storage) (index :<NSUI>nteger) (rangeptr (* :<NSR>ange)))
    520519  #+debug
    521   (#_NSLog #@"Attributes at index: %d" :unsigned index)
     520  (#_NSLog #@"Attributes at index: %ld" :<NSUI>nteger index)
    522521  (let* ((buffer-cache (hemlock-buffer-string-cache (slot-value self 'string)))
    523522         (buffer (buffer-cache-buffer buffer-cache))
     
    653652(objc:defmethod (#/layoutManager:didCompleteLayoutForTextContainer:atEnd: :void)
    654653    ((self hemlock-textstorage-text-view) layout cont (flag :<BOOL>))
    655   (declare (ignore cont flag))
     654  (declare (ignorable cont flag))
    656655  (when (zerop *layout-text-in-background*)
    657     (#/setDelegate: layout (%null-ptr))
     656    (#/setDelegate: layout +null-ptr+)
    658657    (#/setBackgroundLayoutEnabled: layout nil)))
    659658   
     
    687686                               layout
    688687                               char-range
    689                                (%null-ptr))))
     688                               +null-ptr+)))
    690689            #+debug (#_NSLog #@"Flag = %d, location = %d" :<BOOL> (if flag #$YES #$NO) :int (text-view-blink-location self))
    691690            (let* ((rect (#/boundingRectForGlyphRange:inTextContainer:
     
    747746     (length :int)
    748747     (affinity :<NSS>election<A>ffinity))
    749   (when (eql len 0)
     748  (when (eql length 0)
    750749    (update-blink self))
    751   (rlet ((range :ns-range :location pos :length len))
     750  (rlet ((range :ns-range :location pos :length length))
    752751    (%call-next-objc-method self
    753752                            hemlock-textstorage-text-view
     
    757756                            affinity
    758757                            nil)
    759     (#/scrollRangeToVisible self range)))
     758    (#/scrollRangeToVisible: self range)))
    760759 
    761760;;; A specialized NSTextView. The NSTextView is part of the "pane"
     
    769768  (buffer-cache-buffer (hemlock-buffer-string-cache (#/string (#/textStorage self)))))
    770769
    771 (objc:defmethod (#/setString :void) ((self hemlock-textstorage-text-view))
     770(objc:defmethod (#/setString: :void) ((self hemlock-textstorage-text-view) s)
    772771  #+debug
    773772  (#_NSLog #@"hemlock-text-view %@ string set to %@" :id self :id s)
    774   (call-next-method))
     773  (call-next-method) s)
    775774
    776775(define-objc-method (((:struct :_<NSR>ange r)
     
    857856;;; interpreter.
    858857
    859 (objc:defmethod (#/keyDownEvent: :void) ((self hemlock-text-view) event)
     858(objc:defmethod (#/keyDown: :void) ((self hemlock-text-view) event)
    860859  (pass-key-down-event-to-hemlock self event))
    861860
     
    10051004;;; with a bezeled border around it.
    10061005(objc:defmethod (#/drawRect: :void) ((self modeline-view) (rect :<NSR>ect))
    1007   (declare (ignore rect))
     1006  (declare (ignorable rect))
    10081007  (let* ((frame (#/bounds self)))
    10091008     (#_NSDrawWhiteBezel frame frame)
     
    10321031    (let* ((v (call-next-method frame)))
    10331032      (when v
    1034         (let* ((modeline (make-objc-instance 'modeline-view)))
     1033        (let* ((modeline (make-instance 'modeline-view)))
    10351034          (#/addSubview: v modeline)
    10361035          (setf (scroll-view-modeline v) modeline)))
     
    10761075  (#_NSLog #@"Scrolling to point %@" :id (#_NSStringFromPoint p))
    10771076 
    1078   (let* ((char-height (send self 'vertical-line-scroll)))
     1077  (let* ((char-height (#/verticalLineScroll self)))
    10791078    (slet ((proposed (ns-make-point (pref p :<NSP>oint.x)
    10801079                                         (* char-height
     
    11141113
    11151114
    1116 (define-objc-method ((:id :init-with-frame (:<NSR>ect frame))
    1117                      text-pane)
    1118     (let* ((pane (send-super :init-with-frame frame)))
    1119       (unless (%null-ptr-p pane)
    1120         (send pane :set-autoresizing-mask (logior
    1121                                            #$NSViewWidthSizable
    1122                                            #$NSViewHeightSizable))
    1123         (send pane :set-box-type #$NSBoxPrimary)
    1124         (send pane :set-border-type #$NSNoBorder)
    1125         (send pane :set-content-view-margins (ns-make-size (float *text-pane-margin-width* +cgfloat-zero+) (float *text-pane-margin-height* +cgfloat-zero+)))
    1126         (send pane :set-title-position #$NSNoTitle))
    1127       pane))
     1115(objc:defmethod #/initWithFrame: ((self text-pane) (frame :<NSR>ect))
     1116  (let* ((pane (call-next-method frame)))
     1117    (unless (%null-ptr-p pane)
     1118      (#/setAutoresizingMask: pane (logior
     1119                                    #$NSViewWidthSizable
     1120                                    #$NSViewHeightSizable))
     1121      (#/setBoxType: pane #$NSBoxPrimary)
     1122      (#/setBorderType: pane #$NSNoBorder)
     1123      (#/setContentViewMargins: pane (ns:make-ns-size *text-pane-margin-width*  *text-pane-margin-height*))
     1124      (#/setTitlePosition: pane #$NSNoTitle))
     1125    pane))
    11281126
    11291127
    11301128(defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width color)
    1131   (slet ((contentrect (ns-make-rect
    1132                        (float x +cgfloat-zero+)
    1133                        (float y +cgfloat-zero+)
    1134                        (float width +cgfloat-zero+)
    1135                        (float height +cgfloat-zero+))))
    1136     (let* ((scrollview (send (make-objc-instance
    1137                               'modeline-scroll-view
    1138                               :with-frame contentrect) 'autorelease)))
    1139       (send scrollview :set-border-type #$NSBezelBorder)
    1140       (send scrollview :set-has-vertical-scroller t)
    1141       (send scrollview :set-has-horizontal-scroller t)
    1142       (send scrollview :set-rulers-visible nil)
    1143       (send scrollview :set-autoresizing-mask (logior
    1144                                                #$NSViewWidthSizable
    1145                                                #$NSViewHeightSizable))
    1146       (send (send scrollview 'content-view) :set-autoresizes-subviews t)
    1147       (let* ((layout (make-objc-instance 'ns-layout-manager)))
    1148         (send textstorage :add-layout-manager layout)
    1149         (send layout 'release)
    1150         (slet* ((contentsize (send scrollview 'content-size))
    1151                 (containersize (ns-make-size
    1152                                 large-number-for-text
    1153                                 large-number-for-text))
    1154                 (tv-frame (ns-make-rect
    1155                            +cgfloat-zero+
    1156                            +cgfloat-zero+
    1157                            (pref contentsize :<NSS>ize.width)
    1158                            (pref contentsize :<NSS>ize.height))))
    1159           (let* ((container (send (make-objc-instance
    1160                                    'ns-text-container
    1161                                    :with-container-size containersize)
    1162                                   'autorelease)))
    1163             (send layout :add-text-container container)
    1164             (let* ((tv (send (make-objc-instance 'hemlock-text-view
    1165                                                  :with-frame tv-frame
    1166                                                  :text-container container)
    1167                              'autorelease)))
    1168               (send layout :set-delegate tv)
    1169               (send tv :set-min-size (ns-make-size
    1170                                       +cgfloat-zero+
    1171                                       (pref contentsize :<NSS>ize.height)))
    1172               (send tv :set-max-size (ns-make-size large-number-for-text large-number-for-text))
    1173               (send tv :set-rich-text nil)
    1174               (send tv :set-horizontally-resizable t)
    1175               (send tv :set-vertically-resizable t)
    1176               (send tv :set-autoresizing-mask #$NSViewWidthSizable)
    1177               (send tv :set-background-color color)
    1178               (send tv :set-smart-insert-delete-enabled nil)
    1179               (send container :set-width-tracks-text-view tracks-width)
    1180               (send container :set-height-tracks-text-view nil)
    1181               (send scrollview :set-document-view tv)         
    1182               (values tv scrollview))))))))
     1129  (let* ((scrollview (#/autorelease
     1130                      (make-instance
     1131                       'modeline-scroll-view
     1132                       :with-frame (ns:make-ns-rect x y width height)))))
     1133    (#/setBorderType: scrollview #$NSBezelBorder)
     1134    (#/setHasVerticalScroller: scrollview t)
     1135    (#/setHasHorizontalScroller: scrollview t)
     1136    (#/setRulersVisible: scrollview nil)
     1137    (#/setAutoresizingMask: scrollview (logior
     1138                                        #$NSViewWidthSizable
     1139                                        #$NSViewHeightSizable))
     1140    (#/setAutoresizesSubviews: (#/contentView scrollview) t)
     1141    (let* ((layout (make-instance 'ns:ns-layout-manager)))
     1142      (#/addLayoutManager: textstorage layout)
     1143      (#/release layout)
     1144      (let* ((contentsize (#/contentSize scrollview)))
     1145        (rlet ((containersize :ns-size)
     1146               (tv-frame :ns-rect))
     1147          (ns:init-ns-size containersize large-number-for-text large-number-for-text)
     1148          (ns:init-ns-rect tv-frame 0 0 (ns:ns-size-width contentsize) (ns:ns-size-height contentsize))
     1149          (let* ((container (#/autorelease (make-instance
     1150                                            'ns:ns-text-container
     1151                                            :with-container-size containersize))))
     1152            (#/addTextContainer: layout  container)
     1153            (let* ((tv (#/autorelease (make-instance 'hemlock-text-view
     1154                                                     :with-frame tv-frame
     1155                                                     :text-container container))))
     1156              (#/setDelegate: layout tv)
     1157              (#/setMinSize: tv (ns:make-ns-size 0 (ns:ns-size-height contentsize)))
     1158              (#/setMaxSize: tv (ns:make-ns-size large-number-for-text large-number-for-text))
     1159              (#/setRichText: tv nil)
     1160              (#/setHorizontallyResizable: tv t)
     1161              (#/setVerticallyResizable: tv t)
     1162              (#/setAutoresizingMask: tv #$NSViewWidthSizable)
     1163              (#/setBackgroundColor: tv color)
     1164              (#/setSmartInsertDeleteEnabled: tv nil)
     1165              (#/setWidthTracksTextView: container tracks-width)
     1166              (#/setHeightTracksTextView: container nil)
     1167              (#/setDocumentView: scrollview tv)             
     1168              (values tv scrollview))))))))
    11831169
    11841170(defun make-scrolling-textview-for-pane (pane textstorage track-width color)
    1185   (slet ((contentrect (send (send pane 'content-view) 'frame)))
     1171  (let* ((contentrect (#/frame (#/contentView pane))))
    11861172    (multiple-value-bind (tv scrollview)
    11871173        (make-scrolling-text-view-for-textstorage
    11881174         textstorage
    1189          (pref contentrect :<NSR>ect.origin.x)
    1190          (pref contentrect :<NSR>ect.origin.y)
    1191          (pref contentrect :<NSR>ect.size.width)
    1192          (pref contentrect :<NSR>ect.size.height)
     1175         (ns:ns-rect-x contentrect)
     1176         (ns:ns-rect-y contentrect)
     1177         (ns:ns-rect-width contentrect)
     1178         (ns:ns-rect-height contentrect)
    11931179         track-width
    11941180         color)
    1195       (send pane :set-content-view scrollview)
     1181      (#/setContentView: pane scrollview)
    11961182      (setf (slot-value pane 'scroll-view) scrollview
    11971183            (slot-value pane 'text-view) tv
     
    12051191
    12061192(defmethod hi::activate-hemlock-view ((view text-pane))
    1207   (let* ((hemlock-frame (send view 'window))
     1193  (let* ((the-hemlock-frame (#/window view))
    12081194         (text-view (text-pane-text-view view)))
    1209     (send hemlock-frame :make-first-responder text-view)))
     1195    (#/makeFirstResponder: the-hemlock-frame text-view)))
    12101196
    12111197
     
    12151201
    12161202(defmethod hi::activate-hemlock-view ((view echo-area-view))
    1217   (let* ((hemlock-frame (send view 'window)))
     1203  (let* ((the-hemlock-frame (#/window view)))
    12181204    #+debug
    12191205    (#_NSLog #@"Activating echo area")
    1220     (send hemlock-frame :make-first-responder view)))
     1206    (#/makeFirstResponder: the-hemlock-frame view)))
    12211207
    12221208(defmethod text-view-buffer ((self echo-area-view))
    1223   (buffer-cache-buffer (hemlock-buffer-string-cache (send (send self 'text-storage) 'string))))
     1209  (buffer-cache-buffer (hemlock-buffer-string-cache (#/string (#/textStorage self)))))
    12241210
    12251211;;; The "document" for an echo-area isn't a real NSDocument.
     
    12441230(defloadvar *hemlock-frame-count* 0)
    12451231
    1246 (defun make-echo-area (hemlock-frame x y width height gap-context color)
    1247   (slet ((frame (ns-make-rect (float x +cgfloat-zero+)
    1248                               (float y +cgfloat-zero+)
    1249                               (float width +cgfloat-zero+)
    1250                               (float height +cgfloat-zero+))))
    1251     (let* ((box (make-objc-instance "NSView"
    1252                                     :with-frame frame)))
    1253       (send box :set-autoresizing-mask #$NSViewWidthSizable)
    1254       (slet* ((box-frame (send box 'bounds))
    1255               (containersize (ns-make-size large-number-for-text (pref box-frame :<NSR>ect.size.height))))
    1256         (let* ((clipview (make-objc-instance "NSClipView"
    1257                                              :with-frame box-frame)))
    1258           (send clipview :set-autoresizing-mask (logior #$NSViewWidthSizable
    1259                                                         #$NSViewHeightSizable))
    1260           (send clipview :set-background-color color)
    1261           (send box :add-subview clipview)
    1262           (send box :set-autoresizes-subviews t)
    1263           (send clipview 'release)
    1264           (let* ((buffer (hi:make-buffer (format nil "Echo Area ~d"
    1265                                                  (prog1
    1266                                                      *hemlock-frame-count*
    1267                                                    (incf *hemlock-frame-count*)))
    1268                                          :modes '("Echo Area")))
    1269                  (textstorage
    1270                   (progn
    1271                     (setf (hi::buffer-gap-context buffer) gap-context)
    1272                     (make-textstorage-for-hemlock-buffer buffer)))
    1273                  (doc (make-objc-instance 'echo-area-document))
    1274                  (layout (make-objc-instance 'ns-layout-manager))
    1275                  (container (send (make-objc-instance 'ns-text-container
    1276                                                       :with-container-size
    1277                                                       containersize)
    1278                                   'autorelease)))
    1279             (send textstorage :add-layout-manager layout)
    1280             (send layout :add-text-container container)
    1281             (send layout 'release)
    1282             (let* ((echo (make-objc-instance 'echo-area-view
    1283                                              :with-frame box-frame
    1284                                              :text-container container)))
    1285               (send echo :set-min-size (pref box-frame :<NSR>ect.size))
    1286               (send echo :set-max-size (ns-make-size large-number-for-text (pref box-frame :<NSR>ect.size)))
    1287               (send echo :set-rich-text nil)
    1288               (send echo :set-horizontally-resizable t)
    1289               (send echo :set-vertically-resizable nil)
    1290               (send echo :set-autoresizing-mask #$NSViewNotSizable)
    1291               (send echo :set-background-color color)
    1292               (send container :set-width-tracks-text-view nil)
    1293               (send container :set-height-tracks-text-view nil)
    1294               (setf (hemlock-frame-echo-area-buffer hemlock-frame) buffer
    1295                     (slot-value doc 'textstorage) textstorage
    1296                     (hi::buffer-document buffer) doc)
    1297               (send clipview :set-document-view echo)
    1298               (send clipview :set-autoresizes-subviews nil)
    1299               (send echo 'size-to-fit)
    1300               (values echo box))))))))
     1232(defun make-echo-area (the-hemlock-frame x y width height gap-context color)
     1233  (let* ((box (make-instance 'ns:ns-view :with-frame (ns:make-ns-rect x y width height))))
     1234    (#/setAutoresizingMask: box #$NSViewWidthSizable)
     1235    (let* ((box-frame (#/bounds box))
     1236           (containersize (ns:make-ns-size large-number-for-text (ns:ns-rect-height box-frame)))
     1237           (clipview (make-instance 'ns:ns-clip-view
     1238                                    :with-frame box-frame)))
     1239      (#/setAutoresizingMask: clipview (logior #$NSViewWidthSizable
     1240                                               #$NSViewHeightSizable))
     1241      (#/setBackgroundColor: clipview color)
     1242      (#/addSubview: box clipview)
     1243      (#/setAutoresizesSubviews: box t)
     1244      (#/release clipview)
     1245      (let* ((buffer (hi:make-buffer (format nil "Echo Area ~d"
     1246                                             (prog1
     1247                                                 *hemlock-frame-count*
     1248                                               (incf *hemlock-frame-count*)))
     1249                                     :modes '("Echo Area")))
     1250             (textstorage
     1251              (progn
     1252                (setf (hi::buffer-gap-context buffer) gap-context)
     1253                (make-textstorage-for-hemlock-buffer buffer)))
     1254             (doc (make-instance 'echo-area-document))
     1255             (layout (make-instance 'ns:ns-layout-manager))
     1256             (container (#/autorelease
     1257                         (make-instance 'ns:ns-text-container
     1258                                        :with-container-size
     1259                                        containersize))))
     1260        (#/addLayoutManager: textstorage layout)
     1261        (#/addTextContainer: layout container)
     1262        (#/release layout)
     1263        (let* ((echo (make-instance 'echo-area-view
     1264                                    :with-frame box-frame
     1265                                    :text-container container)))
     1266          (#/setMinSize: echo (pref box-frame :<NSR>ect.size))
     1267          (#/setMaxSize: echo (ns:make-ns-size large-number-for-text large-number-for-text))
     1268          (#/setRichText: echo nil)
     1269          (#/setHorizontallyResizable: echo t)
     1270          (#/setVerticallyResizable: echo nil)
     1271          (#/setAutoresizingMask: echo #$NSViewNotSizable)
     1272          (#/setBackgroundColor: echo color)
     1273          (#/setWidthTracksTextView: container nil)
     1274          (#/setHeightTracksTextView: container nil)
     1275          (setf (hemlock-frame-echo-area-buffer the-hemlock-frame) buffer
     1276                (slot-value doc 'textstorage) textstorage
     1277                (hi::buffer-document buffer) doc)
     1278          (#/setDocumentView: clipview echo)
     1279          (#/setAutoresizesSubviews: clipview nil)
     1280          (#/sizeToFit echo)
     1281          (values echo box))))))
    13011282                   
    13021283(defun make-echo-area-for-window (w gap-context-for-echo-area-buffer color)
    1303   (let* ((content-view (send w 'content-view)))
    1304     (slet ((bounds (send content-view 'bounds)))
     1284  (let* ((content-view (#/contentView w))
     1285         (bounds (#/bounds content-view)))
    13051286      (multiple-value-bind (echo-area box)
    13061287          (make-echo-area w
    13071288                          0.0f0
    13081289                          0.0f0
    1309                           (- (pref bounds :<NSR>ect.size.width) 24.0f0)
     1290                          (- (ns:ns-rect-width bounds) 24.0f0)
    13101291                          20.0f0
    13111292                          gap-context-for-echo-area-buffer
    13121293                          color)
    1313         (send content-view :add-subview box)
    1314         echo-area))))
     1294        (#/addSubview: content-view box)
     1295        echo-area)))
    13151296               
    13161297(defclass hemlock-frame (ns:ns-window)
     
    13351316  (%make-nsstring (double-%-in (princ-to-string cond))))
    13361317
    1337 (define-objc-method ((:void :run-error-sheet info) hemlock-frame)
    1338   (let* ((message (send info :object-at-index 0))
    1339          (signal (send info :object-at-index 1)))
     1318(objc:defmethod (#/runErrorSheet: :void) ((self hemlock-frame) info)
     1319  (let* ((message (#/objectAtIndex: info 0))
     1320         (signal (#/objectAtIndex: info 1)))
    13401321    (#_NSBeginAlertSheet #@"Error in Hemlock command processing" ;title
    13411322                         (if (logbitp 0 (random 2))
    13421323                           #@"Not OK, but what can you do?"
    13431324                           #@"The sky is falling. FRED never did this!")
    1344                          (%null-ptr)
    1345                          (%null-ptr)
     1325                         +null-ptr+
     1326                         +null-ptr+
    13461327                         self
    13471328                         self
    1348                          (@selector "sheetDidEnd:returnCode:contextInfo:")
    1349                          (@selector "sheetDidDismiss:returnCode:contextInfo:")
     1329                         (@selector #/sheetDidEnd:returnCode:contextInfo:)
     1330                         (@selector #/sheetDidDismiss:returnCode:contextInfo:)
    13501331                         signal
    13511332                         message)))
    13521333
    1353 (define-objc-method ((:void :sheet-did-end sheet
    1354                             :return-code code
    1355                             :context-info info)
    1356                      hemlock-frame)
     1334(objc:defmethod (#/sheetDidEnd:returnCode:contextInfo: :void) ((self hemlock-frame))
    13571335 (declare (ignore sheet code info)))
    13581336
    1359 (define-objc-method ((:void :sheet-did-dismiss sheet
    1360                             :return-code code
    1361                             :context-info info)
    1362                      hemlock-frame)
     1337(objc:defmethod (#/sheetDidDismiss:returnCode:contextInfo: :void)
     1338    ((self hemlock-frame) sheet code info)
    13631339  (declare (ignore sheet code))
    1364   (ccl::%signal-semaphore-ptr (%int-to-ptr (send info 'unsigned-int-value))))
     1340  (ccl::%signal-semaphore-ptr (%int-to-ptr (#/unsignedLongValue info))))
    13651341 
    13661342(defun report-condition-in-hemlock-frame (condition frame)
    13671343  (let* ((semaphore (make-semaphore))
    13681344         (message (nsstring-for-lisp-condition condition))
    1369          (sem-value (make-objc-instance 'ns:ns-number
    1370                                         :with-unsigned-int (%ptr-to-int (semaphore.value semaphore)))))
     1345         (sem-value (make-instance 'ns:ns-number
     1346                                   :with-unsigned-long (%ptr-to-int (semaphore.value semaphore)))))
    13711347    (%stack-block ((paramptrs (ash 2 target::word-shift)))
    13721348      (setf (%get-ptr paramptrs 0) message
    13731349            (%get-ptr paramptrs (ash 1 target::word-shift)) sem-value)
    1374       (let* ((params (make-objc-instance 'ns:ns-array
    1375                                          :with-objects paramptrs
    1376                                          :count 2))
     1350      (let* ((params (make-instance 'ns:ns-array
     1351                                    :with-objects paramptrs
     1352                                    :count 2))
    13771353             (*debug-io* *typeout-stream*))
    13781354        (stream-clear-output *debug-io*)
    13791355        (print-call-history :detailed-p nil)
    1380         (send frame
    1381               :perform-selector-on-main-thread
    1382               (@selector "runErrorSheet:")
    1383               :with-object params
    1384               :wait-until-done t)
     1356        (#/performSelectorOnMainThread:withObject:waitUntilDone:
     1357         frame (@selector #/runErrorSheet:) params t)
    13851358        (wait-on-semaphore semaphore)))))
    13861359
    13871360(defun hi::report-hemlock-error (condition)
    1388   (report-condition-in-hemlock-frame condition (send (hi::current-window) 'window)))
     1361  (report-condition-in-hemlock-frame condition (#/window (hi::current-window))))
    13891362                       
    13901363                       
     
    14311404
    14321405
    1433 (define-objc-method ((:void close) hemlock-frame)
    1434   (let* ((content-view (send self 'content-view))
    1435          (subviews (send content-view 'subviews)))
    1436     (do* ((i (1- (send subviews 'count)) (1- i)))
     1406(objc:defmethod (#/close :void) ((self hemlock-frame))
     1407  (let* ((content-view (#/contentView self))
     1408         (subviews (#/subviews content-view)))
     1409    (do* ((i (1- (#/count subviews)) (1- i)))
    14371410         ((< i 0))
    1438       (send (send subviews :object-at-index i)
    1439             'remove-from-superview-without-needing-display)))
     1411      (#/removeFromSuperviewWithoutNeedingDisplay (#/objectAtIndex: subviews i))))
    14401412  (let* ((proc (slot-value self 'command-thread)))
    14411413    (when proc
     
    14461418    (when echo-doc
    14471419      (setf (hemlock-frame-echo-area-buffer self) nil)
    1448       (send echo-doc 'close)))
     1420      (#/close echo-doc)))
    14491421  (release-canonical-nsobject self)
    1450   (send-super 'close))
     1422  (call-next-method))
    14511423 
    14521424(defun new-hemlock-document-window ()
    1453   (let* ((w (new-cocoa-window :class (find-class 'hemlock-frame)
     1425  (let* ((w (new-cocoa-window :class hemlock-frame
    14541426                              :activate nil)))
    14551427      (values w (add-pane-to-window w :reserve-below 20.0))))
     
    14581430
    14591431(defun add-pane-to-window (w &key (reserve-above 0.0f0) (reserve-below 0.0f0))
    1460   (let* ((window-content-view (send w 'content-view)))
    1461     (slet ((window-frame (send window-content-view 'frame)))
    1462       (slet ((pane-rect (ns-make-rect +cgfloat-zero+
    1463                                       (float reserve-below +cgfloat-zero+)
    1464                                       (pref window-frame :<NSR>ect.size.width)
    1465                                       (- (pref window-frame :<NSR>ect.size.height) (+ reserve-above reserve-below)))))
    1466         (let* ((pane (make-objc-instance 'text-pane :with-frame pane-rect)))
    1467           (send window-content-view :add-subview pane)
    1468           pane)))))
    1469 
    1470                                        
    1471                                      
     1432  (let* ((window-content-view (#/contentView w))
     1433         (window-frame (#/frame window-content-view)))
     1434    (rlet ((pane-rect ns-rect))
     1435      (ns:init-ns-rect pane-rect 0 reserve-below (ns:ns-rect-width window-frame) (- (ns:ns-rect-height window-frame) (+ reserve-above reserve-below)))
     1436      (let* ((pane (make-instance 'text-pane :with-frame pane-rect)))
     1437        (#/addSubview: window-content-view pane)
     1438        pane))))
     1439
    14721440(defun textpane-for-textstorage (ts ncols nrows container-tracks-text-view-width color)
    14731441  (let* ((pane (nth-value
     
    14891457(defun %nsstring-to-mark (nsstring mark)
    14901458  "returns external-format of string"
    1491   (let* ((string-len (send (the ns:ns-string nsstring) 'length))
     1459  (let* ((string-len (#/length nsstring))
    14921460         (line-start 0)
    14931461         (first-line-terminator ())
     
    15001468           (setf (hi::buffer-gap-context buffer)
    15011469                 (hi::make-buffer-gap-context)))))
    1502     (slet ((remaining-range (ns-make-range 0 1)))
    1503           (rlet ((line-end-index :unsigned)
    1504                  (contents-end-index :unsigned))
    1505             (do* ((number (+ (hi::line-number first-line) hi::line-increment)
    1506                           (+ number hi::line-increment)))
    1507                  ((= line-start string-len)
    1508                   (let* ((line (hi::mark-line mark)))
    1509                     (hi::insert-string mark (make-string 0))
    1510                     (setf (hi::line-next previous) line
    1511                           (hi::line-previous line) previous))
    1512                   nil)
    1513               (setf (pref remaining-range :<NSR>ange.location) line-start)
    1514               (send nsstring
    1515                     :get-line-start (%null-ptr)
    1516                     :end line-end-index
    1517                     :contents-end contents-end-index
    1518                     :for-range remaining-range)
    1519               (let* ((contents-end (pref contents-end-index :unsigned))
    1520                      (line-end (pref line-end-index :unsigned))
    1521                      (chars (make-string (- contents-end line-start))))
    1522                 (do* ((i line-start (1+ i))
    1523                       (j 0 (1+ j)))
    1524                      ((= i contents-end))
    1525                   (setf (schar chars j) (code-char (send nsstring :character-at-index i))))
    1526                 (unless first-line-terminator
    1527                   (let* ((terminator (code-char
    1528                                       (send nsstring :character-at-index
    1529                                             contents-end))))
    1530                     (setq first-line-terminator
    1531                           (case terminator
    1532                             (#\return (if (= line-end (+ contents-end 2))
    1533                                         :cp/m
    1534                                         :macos))
    1535                             (t :unix)))))
    1536                 (if (eq previous first-line)
    1537                   (progn
    1538                     (hi::insert-string mark chars)
    1539                     (hi::insert-character mark #\newline)
    1540                     (setq first-line nil))
    1541                   (if (eq string-len contents-end)
    1542                     (hi::insert-string mark chars)
    1543                     (let* ((line (hi::make-line
    1544                                   :previous previous
    1545                                   :%buffer buffer
    1546                                   :chars chars
    1547                                   :number number)))
    1548                       (setf (hi::line-next previous) line)
    1549                       (setq previous line))))
    1550                 (setq line-start line-end)))))
     1470    (rlet ((remaining-range :ns-range :location 0 :length  1)
     1471           (line-end-index :<NSUI>nteger)
     1472           (contents-end-index :<NSUI>nteger))
     1473      (do* ((number (+ (hi::line-number first-line) hi::line-increment)
     1474                    (+ number hi::line-increment)))
     1475           ((= line-start string-len)
     1476            (let* ((line (hi::mark-line mark)))
     1477              (hi::insert-string mark (make-string 0))
     1478              (setf (hi::line-next previous) line
     1479                    (hi::line-previous line) previous))
     1480            nil)
     1481        (setf (pref remaining-range :<NSR>ange.location) line-start)
     1482        (#/getLineStart:end:contentsEnd:forRange:
     1483         nsstring
     1484         +null-ptr+
     1485         line-end-index
     1486         contents-end-index
     1487         remaining-range)
     1488        (let* ((contents-end (pref contents-end-index :<NSUI>nteger))
     1489               (line-end (pref line-end-index :<NSUI>nteger))
     1490               (chars (make-string (- contents-end line-start))))
     1491          (do* ((i line-start (1+ i))
     1492                (j 0 (1+ j)))
     1493               ((= i contents-end))
     1494            (setf (schar chars j) (code-char (#/characterAtIndex: nsstring i))))
     1495          (unless first-line-terminator
     1496            (let* ((terminator (code-char
     1497                                (#/characterAtIndex: nsstring contents-end))))
     1498              (setq first-line-terminator
     1499                    (case terminator
     1500                      (#\return (if (= line-end (+ contents-end 2))
     1501                                  :cp/m
     1502                                  :macos))
     1503                      (t :unix)))))
     1504          (if (eq previous first-line)
     1505            (progn
     1506              (hi::insert-string mark chars)
     1507              (hi::insert-character mark #\newline)
     1508              (setq first-line nil))
     1509            (if (eq string-len contents-end)
     1510              (hi::insert-string mark chars)
     1511              (let* ((line (hi::make-line
     1512                            :previous previous
     1513                            :%buffer buffer
     1514                            :chars chars
     1515                            :number number)))
     1516                (setf (hi::line-next previous) line)
     1517                (setq previous line))))
     1518          (setq line-start line-end))))
    15511519    first-line-terminator))
    15521520 
     
    15751543         (cocoa-pathname (%make-nsstring lisp-namestring))
    15761544         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
    1577          (data (make-objc-instance 'ns:ns-data
    1578                                    :with-contents-of-file cocoa-pathname))
    1579          (string (make-objc-instance 'ns:ns-string
    1580                                      :with-data data
    1581                                      :encoding #$NSASCIIStringEncoding))
     1545         (data (make-instance 'ns:ns-data
     1546                              :with-contents-of-file cocoa-pathname))
     1547         (string (make-instance 'ns:ns-string
     1548                                :with-data data
     1549                                :encoding #$NSASCIIStringEncoding))
    15821550         (external-format (%nsstring-to-mark string mark)))
    15831551    (unless (hi::buffer-external-format buffer)
     
    15961564(defun %hemlock-frame-for-textstorage (ts ncols nrows container-tracks-text-view-width color)
    15971565  (let* ((pane (textpane-for-textstorage ts ncols nrows container-tracks-text-view-width color))
    1598          (frame (send pane 'window))
     1566         (frame (#/window pane))
    15991567         (buffer (text-view-buffer (text-pane-text-view pane))))
    16001568    (setf (slot-value frame 'echo-area-view)
     
    16331601  (#/performSelectorOnMainThread:withObject:waitUntilDone:
    16341602   (slot-value document 'textstorage)
    1635         (@selector #/beginEditing)
    1636         (%null-ptr)
    1637         t))
     1603   (@selector #/beginEditing)
     1604   +null-ptr+
     1605   t))
    16381606
    16391607(defun document-edit-level (document)
     
    16421610(defun hi::document-end-editing (document)
    16431611  #-all-in-cocoa-thread
    1644   (send (slot-value document 'textstorage) 'end-editing)
     1612  (#/endEditing (slot-value document 'textstorage))
    16451613  #+all-in-cocoa-thread
    1646   (send (slot-value document 'textstorage)
    1647         :perform-selector-on-main-thread
    1648         (@selector "endEditing")
    1649         :with-object (%null-ptr)
    1650         :wait-until-done t))
     1614  (#/performSelectorOnMainThread:withObject:waitUntilDone:
     1615   (slot-value document 'textstorage)
     1616   (@selector #/endEditing)
     1617   +null-ptr+
     1618   t))
    16511619
    16521620(defun hi::document-set-point-position (document)
     
    16551623  (#_NSLog #@"Document set point position called")
    16561624  (let* ((textstorage (slot-value document 'textstorage)))
    1657     (send textstorage
    1658           :perform-selector-on-main-thread
    1659           (@selector "updateHemlockSelection")
    1660           :with-object (%null-ptr)
    1661           :wait-until-done t)))
     1625    (#/performSelectorOnMainThread:withObject:waitUntilDone:
     1626     textstorage (@selector #/updateHemlockSelection) +null-ptr+ t)))
    16621627
    16631628
     
    16651630(defun perform-edit-change-notification (textstorage selector pos n)
    16661631  (let* ((number-for-pos
    1667           (send (send (@class "NSNumber") 'alloc)
    1668                 :init-with-int pos))
    1669          (number-for-n
    1670           (send (send (@class "NSNumber") 'alloc)
    1671                 :init-with-int n)))
    1672     (%stack-block ((paramptrs (ash 2 target::word-shift)))
    1673       (setf (%get-ptr paramptrs 0) number-for-pos
    1674             (%get-ptr paramptrs (ash 1 target::word-shift))
    1675             number-for-n)
    1676       (let* ((params
    1677               (send (send (@class "NSArray") 'alloc)
    1678                     :init-with-objects paramptrs
    1679                     :count 2)))
    1680         (send textstorage
    1681                     :perform-selector-on-main-thread
    1682                     selector
    1683                     :with-object params
    1684                     :wait-until-done t)
    1685               (send params 'release)
    1686               (send number-for-pos 'release)
    1687               (send number-for-n 'release)))))
     1632          (#/initWithLong: (#/alloc ns:ns-number) pos))
     1633         (number-for-n
     1634          (#/initWithLong: (#/alloc ns:ns-number) n)))
     1635    (rlet ((paramptrs (:array :id 2)))
     1636      (setf (paref paramptrs (:* :id) 0) number-for-pos
     1637            (paref paramptrs (:* :id) 1) number-for-n)
     1638      (let* ((params (#/initWithObjects:count: (#/alloc ns:ns-array) paramptrs 2)))
     1639        (#/performSelectorOnMainThread:withObject:waitUntilDone:
     1640         textstorage selector params  t)
     1641        (#/release params)
     1642        (#/release number-for-n)
     1643        (#/release number-for-pos)))))
    16881644
    16891645(defun textstorage-note-insertion-at-position (textstorage pos n)
    16901646  #+debug
    16911647  (#_NSLog #@"insertion at position %d, len %d" :int pos :int n)
    1692   (send textstorage
    1693         :edited #$NSTextStorageEditedAttributes
    1694         :range (ns-make-range pos 0)
    1695         :change-in-length n)
    1696   (send textstorage
    1697         :edited #$NSTextStorageEditedCharacters
    1698         :range (ns-make-range pos n)
    1699         :change-in-length 0))
    1700 
    1701 
     1648  (rlet ((range ns:ns-range :location pos :length 0))
     1649    (#/edited:range:changeInLength:
     1650     textstorage #$NSTextStorageEditedAttributes range n)
     1651    (setf (ns:ns-range-length range) n)
     1652    (#/edited:range:changeInLength:
     1653     textstorage  #$NSTextStorageEditedCharacters range 0)))
    17021654
    17031655
     
    17091661           (n (- (mark-absolute-position (hi::region-end region)) pos)))
    17101662      (perform-edit-change-notification textstorage
    1711                                         (@selector "noteAttrChange:")
     1663                                        (@selector #/noteAttrChange:)
    17121664                                        pos
    17131665                                        n))))
     
    17231675          #+debug
    17241676          (format t "~&insert: pos = ~d, n = ~d" pos n)
    1725           (let* ((display (hemlock-buffer-string-cache (send textstorage 'string))))
     1677          (let* ((display (hemlock-buffer-string-cache (#/string textstorage))))
    17261678            ;(reset-buffer-cache display)
    17271679            (adjust-buffer-cache-for-insertion display pos n)
     
    17451697                 :int n)
    17461698        #-all-in-cocoa-thread
    1747         (send textstorage
    1748           :edited (logior #$NSTextStorageEditedCharacters
     1699        (rlet ((range :ns-range) :location (mark-absolute-position mark) :length n)
     1700          (#/edited:range:changeInLength:
     1701           textstorage
     1702           (logior #$NSTextStorageEditedCharacters
    17491703                          #$NSTextStorageEditedAttributes)
    1750           :range (ns-make-range (mark-absolute-position mark) n)
    1751           :change-in-length 0)
     1704           range
     1705           0))
    17521706        #+all-in-cocoa-thread
    17531707        (perform-edit-change-notification textstorage
    1754                                           (@selector "noteModification:")
     1708                                          (@selector #/noteModification:)
    17551709                                          (mark-absolute-position mark)
    17561710                                          n)))))
     
    17641718        #-all-in-cocoa-thread
    17651719        (let* ((pos (mark-absolute-position mark)))
    1766           (send textstorage
    1767           :edited #$NSTextStorageEditedCharacters
    1768           :range (ns-make-range pos n)
    1769           :change-in-length (- n))
    1770           (let* ((display (hemlock-buffer-string-cache (send textstorage 'string))))
     1720          (rlet ((range :ns-range :location pos :length n))
     1721          (#/edited:range:changeInLength:
     1722           textstorage #$NSTextStorageEditedCharacters range (- n)))
     1723          (let* ((display (hemlock-buffer-string-cache (#/string textstorage))))
    17711724            (reset-buffer-cache display)
    17721725            (update-line-cache-for-index display pos)))
    17731726        #+all-in-cocoa-thread
    17741727        (perform-edit-change-notification textstorage
    1775                                           (@selector "noteDeletion:")
     1728                                          (@selector #/noteDeletion:)
    17761729                                          (mark-absolute-position mark)
    17771730                                          (abs n))))))
    17781731
    17791732(defun hi::set-document-modified (document flag)
    1780   (send document
    1781         :update-change-count (if flag #$NSChangeDone #$NSChangeCleared)))
     1733  (#/updateChangeCount: document (if flag #$NSChangeDone #$NSChangeCleared)))
    17821734
    17831735
     
    17901742
    17911743(defun size-of-char-in-font (f)
    1792   (let* ((sf (send f 'screen-font)))
    1793     (if (%null-ptr-p sf) (setq sf f))
    1794     (values (fround
    1795              (+ (- (send sf 'ascender)
    1796                    (send sf 'descender))
    1797                 (send sf 'leading)))
    1798             (slet ((s (send sf 'maximum-advancement)))
    1799               (fround (pref s :<NSS>ize.width))))))
     1744  (let* ((sf (#/screenFont f))
     1745         (screen-p t))
     1746    (if (%null-ptr-p sf) (setq sf f screen-p nil))
     1747    (let* ((layout (#/autorelease (#/init (#/alloc ns:ns-layout-manager)))))
     1748      (#/setUsesScreenFonts: layout screen-p)
     1749      (values (fround (#/defaultLineHeightForFont: layout sf))
     1750              (fround (ns:ns-size-width (#/advancementForGlyph: sf (#/glyphWithName: sf #@" "))))))))
    18001751         
    18011752
     
    18061757         (width (fceiling (* ncols char-width)))
    18071758         (scrollview (text-pane-scroll-view pane))
    1808          (window (send scrollview 'window))
    1809          (has-horizontal-scroller (send scrollview 'has-horizontal-scroller))
    1810          (has-vertical-scroller (send scrollview 'has-vertical-scroller)))
    1811     (rlet ((tv-size :<NSS>ize :height height
    1812                     :width (+ width (* 2 (send (send tv 'text-container)
    1813                                                'line-fragment-padding)))))
     1759         (window (#/window scrollview))
     1760         (has-horizontal-scroller (#/hasHorizontalScroller scrollview))
     1761         (has-vertical-scroller (#/hasVerticalScroller scrollview)))
     1762    (rlet ((tv-size :ns-size))
     1763      (ns:init-ns-size tv-size
     1764                       (+ width (* 2 (#/lineFragmentPadding (#/textContainer tv))))
     1765                       height)
    18141766      (when has-vertical-scroller
    1815         (send scrollview :set-vertical-line-scroll char-height)
    1816         (send scrollview :set-vertical-page-scroll +cgfloat-zero+ #|char-height|#))
     1767        (#/setVerticalLineScroll: scrollview char-height)
     1768        (#/setVerticalPageScroll: scrollview +cgfloat-zero+ #|char-height|#))
    18171769      (when has-horizontal-scroller
    1818         (send scrollview :set-horizontal-line-scroll char-width)
    1819         (send scrollview :set-horizontal-page-scroll +cgfloat-zero+ #|char-width|#))
    1820       (slet ((sv-size
    1821               (send (@class ns-scroll-view)
    1822                     :frame-size-for-content-size tv-size
    1823                     :has-horizontal-scroller has-horizontal-scroller
    1824                     :has-vertical-scroller has-vertical-scroller
    1825                     :border-type (send scrollview 'border-type))))
    1826         (slet ((pane-frame (send pane 'frame))
    1827                (margins (send pane 'content-view-margins)))
    1828           (incf (pref sv-size :<NSS>ize.height)
    1829                 (+ (pref pane-frame :<NSR>ect.origin.y)
    1830                    (* 2 (pref margins :<NSS>ize.height))))
    1831           (incf (pref sv-size :<NSS>ize.width)
    1832                 (pref margins :<NSS>ize.width))
    1833           (send window :set-content-size sv-size)
    1834           (send window :set-resize-increments
    1835                 (ns-make-size char-width char-height)))))))
     1770        (#/setHorizontalLineScroll: scrollview char-width)
     1771        (#/setHorizontalPageScroll: scrollview +cgfloat-zero+ #|char-width|#))
     1772      (let* ((sv-size (#/frameSizeForContentSize:hasHorizontalScroller:hasVerticalScroller:borderType: ns:ns-scroll-view tv-size has-horizontal-scroller has-vertical-scroller (#/borderType scrollview)))
     1773             (pane-frame (#/frame pane))
     1774             (margins (#/contentViewMargins pane)))
     1775        (incf (ns:ns-size-height sv-size)
     1776              (+ (ns:ns-rect-y pane-frame)
     1777                 (* 2 (ns:ns-size-height  margins))))
     1778        (incf (ns:ns-size-width sv-size)
     1779              (ns:ns-size-width margins))
     1780        (#/setContentSize: window sv-size)
     1781        (#/setResizeIncrements: window
     1782                                (ns:make-ns-size char-width char-height))))))
    18361783                                   
    18371784 
     
    18421789
    18431790
    1844 (define-objc-method ((:void :_window-will-close notification)
    1845                      hemlock-editor-window-controller)
    1846   #+debug
    1847   (let* ((w (send notification 'object)))
    1848     (#_NSLog #@"Window controller: window will close: %@" :id w))
    1849   (send-super :_window-will-close notification))
    1850 
    18511791;;; The HemlockEditorDocument class.
    18521792
     
    18571797
    18581798(defmethod textview-background-color ((doc hemlock-editor-document))
    1859   (send (find-class 'ns:ns-color)
    1860         :color-with-calibrated-red (float *editor-background-red-component*
    1861                                           +cgfloat-zero+)
    1862         :green (float *editor-background-green-component* +cgfloat-zero+)
    1863         :blue (float *editor-background-blue-component* +cgfloat-zero+)
    1864         :alpha (float *editor-background-alpha-component* +cgfloat-zero+)))
    1865 
    1866 
    1867 (define-objc-method ((:void :set-text-storage ts)
    1868                      hemlock-editor-document)
    1869   (let* ((doc (%inc-ptr self 0))
    1870          (string (send ts 'string))
     1799  (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color
     1800                                              (float *editor-background-red-component*
     1801                                                     +cgfloat-zero+)
     1802                                              (float *editor-background-green-component* +cgfloat-zero+)
     1803                                              (float *editor-background-blue-component* +cgfloat-zero+)
     1804                                              (float *editor-background-alpha-component* +cgfloat-zero+)))
     1805
     1806
     1807(objc:defmethod (#/setTextStorage: :void) ((self hemlock-editor-document) ts)
     1808  (let* ((doc (%inc-ptr self 0))        ; workaround for stack-consed self
     1809         (string (#/string ts))
    18711810         (cache (hemlock-buffer-string-cache string))
    18721811         (buffer (buffer-cache-buffer cache)))
     
    18761815
    18771816;; This runs on the main thread.
    1878 (define-objc-method ((:<BOOL> :revert-to-saved-from-file filename
    1879                               :of-type filetype)
    1880                      hemlock-editor-document)
     1817(objc:defmethod (#/revertToSavedFromFile:ofType: :<BOOL>)
     1818    ((self hemlock-editor-document) filename filetype)
    18811819  (declare (ignore filetype))
    18821820  #+debug
    18831821  (#_NSLog #@"revert to saved from file %@ of type %@"
    18841822           :id filename :id filetype)
    1885   (let* ((data (make-objc-instance 'ns:ns-data
    1886                                    :with-contents-of-file filename))
    1887          (nsstring (make-objc-instance 'ns:ns-string
    1888                                      :with-data data
    1889                                      :encoding #$NSASCIIStringEncoding))
     1823  (let* ((data (make-instance ns:ns-data
     1824                              :with-contents-of-file filename))
     1825         (nsstring (make-instance ns:ns-string
     1826                                  :with-data data
     1827                                  :encoding #$NSASCIIStringEncoding))
    18901828         (buffer (hemlock-document-buffer self))
    18911829         (old-length (hemlock-buffer-length buffer))
     
    18941832         (point (hi::buffer-point buffer))
    18951833         (pointpos (mark-absolute-position point)))
    1896     (send textstorage 'begin-editing)
    1897     (send textstorage
    1898           :edited #$NSTextStorageEditedCharacters
    1899           :range (ns-make-range 0 old-length)
    1900           :change-in-length (- old-length))
     1834    (#/beginEditing textstorage)
     1835    (rlet ((changed :ns-range :location 0 :length old-length))
     1836      (#/edited:range:changeInLength:
     1837       textstorage #$NSTextStorageEditedCharacters changed (- old-length)))
    19011838    (nsstring-to-buffer nsstring buffer)
    1902     (let* ((newlen (hemlock-buffer-length buffer)))
    1903       (send textstorage
    1904             :edited #$NSTextStorageEditedAttributes
    1905             :range (ns-make-range 0 0)
    1906             :change-in-length newlen)
    1907       (send textstorage
    1908             :edited #$NSTextStorageEditedCharacters
    1909             :range (ns-make-range 0 newlen)
    1910             :change-in-length 0)
    1911       (let* ((ts-string (send textstorage 'string))
    1912              (display (hemlock-buffer-string-cache ts-string)))
    1913         (reset-buffer-cache display)
    1914         (update-line-cache-for-index display 0)
    1915         (move-hemlock-mark-to-absolute-position point
    1916                                                 display
    1917                                                 (min newlen pointpos)))
    1918       (send textstorage 'end-editing))
     1839    (rletZ ((new-range :ns-range))
     1840      (let* ((newlen (hemlock-buffer-length buffer)))
     1841        (#/edited:range:changeInLength: textstorage  #$NSTextStorageEditedAttributes new-range newlen)
     1842        (setf (ns:ns-range-length new-range) newlen)
     1843        (#/edited:range:changeInLength: textstorage #$NSTextStorageEditedCharacters new-range 0)
     1844        (let* ((ts-string (#/string textstorage))
     1845               (display (hemlock-buffer-string-cache ts-string)))
     1846          (reset-buffer-cache display)
     1847          (update-line-cache-for-index display 0)
     1848          (move-hemlock-mark-to-absolute-position point
     1849                                                  display
     1850                                                  (min newlen pointpos))))
     1851      (#/endEditing textstorage))
    19191852    (hi::document-set-point-position self)
    19201853    (setf (hi::buffer-modified buffer) nil)
     
    19241857           
    19251858 
    1926 (define-objc-method ((:id init) hemlock-editor-document)
    1927   (let* ((doc (send-super 'init)))
     1859(objc:defmethod #/init ((self hemlock-editor-document))
     1860  (let* ((doc (call-next-method)))
    19281861    (unless  (%null-ptr-p doc)
    1929       (send doc
    1930         :set-text-storage (make-textstorage-for-hemlock-buffer
    1931                            (make-hemlock-buffer
    1932                             (lisp-string-from-nsstring
    1933                              (send doc 'display-name))
    1934                             :modes '("Lisp" "Editor")))))
     1862      (#/setTextStorage: doc (make-textstorage-for-hemlock-buffer
     1863                              (make-hemlock-buffer
     1864                               (lisp-string-from-nsstring
     1865                                (#/displayName doc))
     1866                               :modes '("Lisp" "Editor")))))
    19351867    doc))
    19361868                     
    1937 
    1938 (define-objc-method ((:<BOOL> :read-from-file filename
    1939                               :of-type type)
    1940                      hemlock-editor-document)
     1869(objc:defmethod (#/readFromFile:ofType: :<BOOL>)
     1870    ((self hemlock-editor-document) filename type)
    19411871  (declare (ignorable type))
    19421872  (let* ((pathname (lisp-string-from-nsstring filename))
     
    19501880                    b)))
    19511881         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
    1952          (data (make-objc-instance 'ns:ns-data
    1953                                    :with-contents-of-file filename))
    1954          (string (make-objc-instance 'ns:ns-string
    1955                                      :with-data data
    1956                                      :encoding #$NSASCIIStringEncoding)))
     1882         (data (make-instance 'ns:ns-data :with-contents-of-file filename))
     1883         (string (make-instance 'ns:ns-string
     1884                                :with-data data
     1885                                :encoding #$NSASCIIStringEncoding)))
    19571886    (hi::document-begin-editing self)
    19581887    (nsstring-to-buffer string buffer)
    19591888    (let* ((textstorage (slot-value self 'textstorage))
    1960            (display (hemlock-buffer-string-cache (send textstorage 'string))))
     1889           (display (hemlock-buffer-string-cache (#/string textstorage))))
    19611890      (reset-buffer-cache display)
    19621891      (update-line-cache-for-index display 0)
     
    19681897    (setf (hi::buffer-modified buffer) nil)
    19691898    (hi::process-file-options buffer pathname)
    1970     #$YES))
     1899    t))
    19711900
    19721901#+experimental
     
    19781907
    19791908;;; This should be a preference.
    1980 (define-objc-method ((:<BOOL> keep-backup-file)
    1981                      hemlock-editor-document)
    1982   #$YES)
     1909(objc:defmethod (#/keepBackupFile :<BOOL>) ((self hemlock-editor-document))
     1910  t)
    19831911
    19841912
    19851913(defmethod hemlock-document-buffer (document)
    1986   (let* ((string (send (slot-value document 'textstorage) 'string)))
     1914  (let* ((string (#/string (slot-value document 'textstorage))))
    19871915    (unless (%null-ptr-p string)
    19881916      (let* ((cache (hemlock-buffer-string-cache string)))
     
    20001928    panes))
    20011929
    2002 (define-objc-method ((:id :data-representation-of-type type)
    2003                       hemlock-editor-document)
     1930(objc:defmethod #/dataRepresentationOfType: ((self hemlock-editor-document)
     1931                                             type)
    20041932  (declare (ignorable type))
    20051933  (let* ((buffer (hemlock-document-buffer self)))
    20061934    (when buffer
    20071935      (setf (hi::buffer-modified buffer) nil)))
    2008   (send (send (slot-value self 'textstorage) 'string)
    2009         :data-using-encoding #$NSASCIIStringEncoding
    2010         :allow-lossy-conversion t))
     1936  (#/dataUsingEncoding:allowLossyConversion:
     1937   (#/string (slot-value self 'textstorage)) #$NSASCIIStringEncoding t))
    20111938
    20121939
    20131940;;; Shadow the setFileName: method, so that we can keep the buffer
    20141941;;; name and pathname in synch with the document.
    2015 (define-objc-method ((:void :set-file-name full-path)
    2016                      hemlock-editor-document)
    2017   (send-super :set-file-name full-path)
     1942(objc:defmethod (#/setFileName: :void) ((self hemlock-editor-document)
     1943                                        full-path)
     1944  (call-next-method full-path)
    20181945  (let* ((buffer (hemlock-document-buffer self)))
    20191946    (when buffer
     
    20301957(defloadvar *next-editor-y-pos* nil)
    20311958
    2032 (define-objc-method ((:void make-window-controllers) hemlock-editor-document)
     1959(objc:defmethod (#/makeWindowControllers :void) ((self hemlock-editor-document))
    20331960  #+debug
    20341961  (#_NSLog #@"Make window controllers")
     
    20391966                                    nil
    20401967                                    (textview-background-color self)))
    2041          (controller (make-objc-instance
     1968         (controller (make-instance
    20421969                      'hemlock-editor-window-controller
    20431970                      :with-window window)))
    2044     (send self :add-window-controller controller)
    2045     (send controller 'release)
    2046     (slet ((current-point (ns-make-point (or *next-editor-x-pos*
    2047                                              (float *initial-editor-x-pos*
    2048                                                     +cgfloat-zero+))
    2049                                          (or *next-editor-y-pos*
    2050                                              (float *initial-editor-y-pos*
    2051                                                     +cgfloat-zero+)))))
    2052       (slet ((new-point (send window
    2053                               :cascade-top-left-from-point current-point)))
    2054             (setf *next-editor-x-pos* (pref new-point :<NSP>oint.x)
    2055                   *next-editor-y-pos* (pref new-point :<NSP>oint.y))))))
    2056 
    2057 
    2058 (define-objc-method ((:void close) hemlock-editor-document)
     1971    (#/addWindowController: self controller)
     1972    (#/release controller)
     1973    (rlet ((current-point :ns-point))
     1974      (ns:init-ns-point current-point
     1975                        (or *next-editor-x-pos*
     1976                            *initial-editor-x-pos*)
     1977                        (or *next-editor-y-pos*
     1978                            *initial-editor-y-pos*))
     1979      (let* ((new-point (#/cascadeTopLeftFromPoint: window current-point)))
     1980        (setq *next-editor-x-pos* (ns:ns-point-x new-point)
     1981              *next-editor-y-pos* (ns:ns-point-y new-point))))))
     1982
     1983
     1984(objc:defmethod (#/close :void) ((self hemlock-editor-document))
    20591985  #+debug
    20601986  (#_NSLog #@"Document close: %@" :id self)
     
    20651991       textstorage
    20661992       #'(lambda (tv)
    2067            (let* ((layout (send tv 'layout-manager)))
    2068              (send layout :set-background-layout-enabled nil))))
     1993           (let* ((layout (#/layoutManager tv)))
     1994             (#/setBackgroundLayoutEnabled: layout nil))))
    20691995      (close-hemlock-textstorage textstorage)))
    2070   (send-super 'close))
     1996  (call-next-method))
    20711997
    20721998
    20731999(defun initialize-user-interface ()
    2074   (send (find-class 'preferences-panel) 'shared-panel)
     2000  (#/sharedPanel preferences-panel)
    20752001  (update-cocoa-defaults)
    20762002  (make-editor-style-map))
     
    20822008
    20832009(defmethod hemlock::center-text-pane ((pane text-pane))
    2084   (send (text-pane-text-view pane)
    2085         :center-selection-in-visible-area (%null-ptr)))
     2010  (#/centerSelectionInVisibleArea: (text-pane-text-view pane) +null-ptr+))
    20862011
    20872012
    20882013(defun hi::open-document ()
    2089   (send (send (find-class 'ns:ns-document-controller)
    2090               'shared-document-controller)
    2091         :perform-selector-on-main-thread (@selector "openDocument:")
    2092         :with-object (%null-ptr)
    2093         :wait-until-done t))
     2014  (#/performSelectorOnMainThread:withObject:waitUntilDone:
     2015   (#/sharedDocumentController ns:ns-document-controller)
     2016   (@selector #/openDocument:) +null-ptr+ t))
    20942017 
    20952018(defmethod hi::save-hemlock-document ((self hemlock-editor-document))
    2096   (send self
    2097         :perform-selector-on-main-thread (@selector "saveDocument:")
    2098         :with-object (%null-ptr)
    2099         :wait-until-done t))
     2019  (#/performSelectorOnMainThread:withObject:waitUntilDone:
     2020   self (@selector #/saveDocument:) +null-ptr+ t))
    21002021
    21012022
    21022023(defmethod hi::save-hemlock-document-as ((self hemlock-editor-document))
    2103   (send self
    2104         :perform-selector-on-main-thread (@selector "saveDocumentAs:")
    2105         :with-object (%null-ptr)
    2106         :wait-until-done t))
     2024  (#/performSelectorOnMainThread:withObject:waitUntilDone:
     2025   self (@selector #/saveDocumentAs:) +null-ptr+ t))
    21072026
    21082027;;; This needs to run on the main thread.
    2109 (define-objc-method ((:void update-hemlock-selection)
    2110                      hemlock-text-storage)
    2111   (let* ((string (send self 'string))
     2028(objc:defmethod (#/updateHemlockSelection :void) ((self hemlock-text-storage))
     2029  (let* ((string (#/string self))
    21122030         (buffer (buffer-cache-buffer (hemlock-buffer-string-cache string)))
    21132031         (hi::*buffer-gap-context* (hi::buffer-gap-context buffer))
     
    21302048     self
    21312049     #'(lambda (tv)
    2132          (send tv
    2133                :update-selection location
    2134                :length len
    2135                :affinity (if (eql location 0)
    2136                            #$NSSelectionAffinityUpstream
    2137                            #$NSSelectionAffinityDownstream))))))
     2050         (#/updateSelection:length:affinity: tv location len (if (eql location 0) #$NSSelectionAffinityUpstream #$NSSelectionAffinityDownstream))))))
    21382051
    21392052
  • branches/objc-gf/ccl/examples/cocoa-inspector.lisp

    r430 r6130  
    6262   (ns-constant-string string)))
    6363
    64 
     64#+old
    6565(defmacro handler-case-for-cocoa (id form)
    6666  (declare (ignorable id))
     
    239239
    240240
    241 ;; is there some reason this is called before the cell is actually selected? In any case,
    242 ;; when a non-leaf cell is selected, this function is called first for the new column,
    243 ;; so it has to push the new element into the cinspector -- what the browserAction will
    244 ;; be left doing it remains to be seen. The only other time this is called AFAICT is
    245 ;; when loadColumnZero or reloadColumn is called
     241;;; is there some reason this is called before the cell is actually
     242;;; selected? In any case, when a non-leaf cell is selected, this
     243;;; function is called first for the new column, so it has to push the
     244;;; new element into the cinspector -- what the browserAction will be
     245;;; left doing it remains to be seen. The only other time this is
     246;;; called AFAICT is when loadColumnZero or reloadColumn is called
    246247(define-objc-method ((:int :browser browser
    247248                           :number-of-rows-in-column (:int column))
    248249                           inspector-browser-delegate)
    249   (or (handler-case-for-cocoa 1
    250        (let* ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*))
     250  (or (let* ((cinspector (gethash (inspector-window self) *cocoa-inspector-nswindows-table*))
    251251              (selected-column (send browser 'selected-column)) ; probably always (1- column), when a column is selected
    252252              (cinspector-column (1- selected-column)) ; 2nd column of nsbrowser <-> 1st column of cinspector
     
    255255         (format t "getting length of column ~d based on row ~d in column ~d~%" column row selected-column)
    256256         (cond ((not cinspector) 0)
    257                ((= column 0) 1) ; just displaying the printed representaiton of the top inspected object
     257               ((= column 0) 1)         ; just displaying the printed representaiton of the top inspected object
    258258               ((= selected-column 0) ; selected the printed rep of the inspected object (column should = 1)
    259259                (setf (max-column cinspector) 0) ; crop object-vector in cinspector
     
    264264                (push-object (nth-object-nth-value cinspector cinspector-column row) cinspector)
    265265                (let ((inspector (nth-inspector cinspector (1+ cinspector-column)))) ; inspector for object just pushed
    266                   (inspector::inspector-line-count inspector))))))
     266                  (inspector::inspector-line-count inspector)))))
    267267      0))
    268268
     
    298298            (send cell :set-leaf nil))
    299299           (t
    300             ;; when switching between widgets to the browser, we can have reloaded a column
    301             ;; and need to drill down a row from where we are at the moment
     300            ;; when switching between widgets to the browser, we can
     301            ;; have reloaded a column and need to drill down a row
     302            ;; from where we are at the moment
    302303            (send cell :set-string-value  (nsstringptr (nth-object-nth-line cinspector cinspector-column row)))
    303             ;; leaf-p should really consider the type of the object in question
    304             ;; (eventually taking into account whether we're brousing the class heirarchy or into objc or whatever)
     304            ;; leaf-p should really consider the type of the object in
     305            ;; question (eventually taking into account whether we're
     306            ;; brousing the class heirarchy or into objc or whatever)
    305307            (send cell :set-leaf (or (leaf-node-p (nth-object cinspector cinspector-column)) ; i.e. no fields drill down
    306308                                                    (leaf-field-p (nth-object cinspector cinspector-column) row)
     
    309311                                                    (not (nth-object-nth-value-editable cinspector cinspector-column row)))))))))
    310312
    311 ;; when all is said and done and once the cinspector is properly
    312 ;; populated, the selected object in the browser's nth column is
    313 ;; actually the object in the cinspector's nth column (i.e. because
    314 ;; the selected object is displayed in the next browser column over,
    315 ;; and the cinspector and nsbrowser have a 1-off discrepancy, they
    316 ;; cancel out) -- just a note to make the difference between these
    317 ;; next two functions and the previous two functions
    318 
    319 ;; change the focus of the the table view to be the selected object
     313;;; when all is said and done and once the cinspector is properly
     314;;; populated, the selected object in the browser's nth column is
     315;;; actually the object in the cinspector's nth column (i.e. because
     316;;; the selected object is displayed in the next browser column over,
     317;;; and the cinspector and nsbrowser have a 1-off discrepancy, they
     318;;; cancel out) -- just a note to make the difference between these
     319;;; next two functions and the previous two functions
     320
     321;;; change the focus of the the table view to be the selected object
    320322(define-objc-method ((:void :browser-action sender)
    321323                     inspector-browser-delegate) ; don't know why I'd want to, but could use a separate IBTarget class
     
    417419    (remhash nswindow *cocoa-inspector-nswindows-table*)))
    418420
    419 ; hopefully a generally useful function
     421;;; hopefully a generally useful function
    420422(defun load-windowcontroller-from-nib (wc-classname nib-pathname)
    421423  "Takes a NIB name and returns a new window controller"
    422424  (with-autorelease-pool
    423       (make-objc-instance
     425      (make-instance
    424426       wc-classname
    425427       :with-window-nib-name (nsstringptr (namestring nib-pathname)))))
    426428
    427 ; make a new inspector window from the nib file, and hash the window's
    428 ; browser and tableview to the object
     429;;; make a new inspector window from the nib file, and hash the window's
     430;;; browser and tableview to the object
    429431(defun cinspect (object)
    430432  (with-autorelease-pool
  • branches/objc-gf/ccl/examples/cocoa-listener.lisp

    r6112 r6130  
    2727  ;; Since the same (Unix) process will be reading from and writing
    2828  ;; to the pty, it's critical that we make the pty non-blocking.
     29  ;; Has this been true for the last few years (native threads) ?
    2930  (fd-set-flag pty #$O_NONBLOCK)
    3031  (disable-tty-local-modes pty (logior #$ECHO #$ECHOCTL #$ISIG))
     
    6667                    doc
    6768                    (@selector #/close)
    68                     (%null-ptr)
     69                    +null-ptr+
    6970                    nil))))
    7071           :initial-function
     
    9091;;; close boxes to be highlighted.
    9192(objc:defmethod (#/setDocumentEdited: :void)
    92     ((self hemlock-listener-window-controller) (:<BOOL> edited))
     93    ((self hemlock-listener-window-controller) (edited :<BOOL>))
    9394  (declare (ignorable edited)))
    9495 
     
    99100      (multiple-value-bind (server client) (ignore-errors (open-pty-pair))
    100101        (when server
    101           (let* ((fh (make-objc-instance
    102                       'ns-file-handle
     102          (let* ((fh (make-instance
     103                      'ns:ns-file-handle
    103104                      :with-file-descriptor (setup-server-pty server)
    104105                      :close-on-dealloc t)))
     
    116117(objc:defmethod (#/gotData: :void) ((self hemlock-listener-window-controller)
    117118                                    notification)
     119  #+debug (#_NSLog #@"gotData: !")
    118120  (with-slots (filehandle) self
    119121    (let* ((data (#/objectForKey: (#/userInfo notification)
     
    158160         (filehandle (slot-value controller 'filehandle))
    159161         (len (length string))
    160          (data (#/autorelease (make-objc-instance 'ns-mutable-data
    161                                                   :with-length len)))
     162         (data (#/autorelease (make-instance 'ns:ns-mutable-data
     163                                             :with-length len)))
    162164         (bytes (#/mutableBytes data)))
    163165    (%cstr-pointer string bytes nil)
     
    166168
    167169
    168 (objc:defmethod #/topListener ((self hemlock-listener-document))
     170(objc:defmethod #/topListener ((self +hemlock-listener-document))
    169171  (let* ((all-documents (#/orderedDocuments *NSApp*)))
    170172    (dotimes (i (#/count all-documents) (%null-ptr))
     
    218220                  t
    219221                  (textview-background-color self)))
    220          (controller (make-objc-instance
     222         (controller (make-instance
    221223                      'hemlock-listener-window-controller
    222224                      :with-window window))
     
    246248
    247249;;; Action methods
    248 (objd:defmethod (#/interrupt: :void) ((self hemlock-listener-document) sender)
     250(objc:defmethod (#/interrupt: :void) ((self hemlock-listener-document) sender)
    249251  (declare (ignore sender))
    250252  (let* ((buffer (hemlock-document-buffer self))
     
    263265      (let* ((context (listener-backtrace-context process)))
    264266        (when context
    265           (#/showWindow: (backtrace-controller-for-context context) (%null-ptr)))))))
     267          (#/showWindow: (backtrace-controller-for-context context) +null-ptr+))))))
    266268
    267269;;; Menu item action validation.  It'd be nice if we could distribute this a
     
    284286      (values nil nil))))
    285287
    286 (objc:defmethod (#/validateMenuItem :<BOOL>)
     288(objc:defmethod (#/validateMenuItem: :<BOOL>)
    287289    ((self hemlock-listener-document) item)
    288290  (multiple-value-bind (have-opinion opinion)
     
    325327                                                    selection)
    326328  (declare (ignore selection))
    327   (let* ((top-listener-document (#/topListener hemlock-listener-document)
     329  (let* ((top-listener-document (#/topListener hemlock-listener-document)))
    328330    (if top-listener-document
    329331      (let* ((buffer (hemlock-document-buffer top-listener-document)))
  • branches/objc-gf/ccl/examples/cocoa-prefs.lisp

    r6112 r6130  
    3838  (let* ((doc (cocoa-default-doc default))
    3939         (type (cocoa-default-type default)))
    40     (send cell :set-tag index)
    41           (send cell :set-string-value val)
    42           (when doc
    43             (send form
    44                   :set-tool-tip (%make-nsstring doc)
    45                   :for-cell cell))
    46           (case type
    47             (:int
    48              (send cell :set-entry-type #$NSIntType)
    49              '(send cell :set-alignment #$NSRightTextAlignment))
    50             (:float
    51              (send cell :set-entry-type #$NSFloatType)
    52              '(send cell :set-alignment #$NSRightTextAlignment))
    53             (t
    54              (send cell :set-scrollable t)))
    55           (send cell :set-action (@selector "notePrefsChange:"))
    56           (send cell :set-target self)))
     40    (#/setTag: cell index)
     41    (#/setStringValue: cell val)
     42    (when doc
     43      (#/setToolTip:forCell: form (%make-nsstring doc) cell))
     44    (case type
     45      (:int
     46       (#/setEntryType: cell #$NSIntType)
     47       '(#/setAlignment: cell #$NSRightTextAlignment))
     48      (:float
     49       (#/setEntryType: cell #$NSFloatType)
     50       '(#/setAlignment: cell #$NSRightTextAlignment))
     51      (t
     52       (#/setScrollable: cell t)))
     53    (#/setAction: cell (@selector #/notePrefsChange:))
     54    (#/setTarget: cell self)))
    5755
    5856(defmethod create-prefs-view-form ((self prefs-view))
    59   (let* ((scrollview (prefs-view-scroll-view self)))
    60     (slet* ((contentsize (send scrollview 'content-size))
    61             (form-frame (ns-make-rect
    62                          +cgfloat-zero+
    63                          +cgfloat-zero+
    64                          (pref contentsize :<NSS>ize.width)
    65                          (pref contentsize :<NSS>ize.height))))
    66       (let* ((form (make-objc-instance 'ns:ns-form :with-frame form-frame)))
    67         (send form :set-scrollable t)
    68         (send form :set-intercell-spacing (ns-make-size (float 1.0f0 +cgfloat-zero+) (float 4.0f0 +cgfloat-zero+)))
    69         (send form :set-cell-size (ns-make-size (float 500.0f0 +cgfloat-zero+) (float 22.0f0 +cgfloat-zero+)))
     57  (let* ((scrollview (prefs-view-scroll-view self))
     58         (contentsize (#/contentSize scrollview)))
     59    (rlet ((form-frame :ns-rect)
     60           (intercell-spacing-size :ns-size)
     61           (cell-size :ns-size))
     62      (ns:init-ns-rect form-frame 0 0 (ns:ns-size-width contentsize) (ns:ns-size-height contentsize))
     63      (ns:init-ns-size intercell-spacing-size 1 4)
     64      (ns:init-ns-size cell-size 500 22)
     65      (let* ((form (make-instance 'ns:ns-form :with-frame form-frame)))
     66        (#/setScrollable: form t)
     67        (#/setIntercellSpacing: form intercell-spacing-size)
     68        (#/setCellSize: form cell-size)
    7069        (setf (prefs-view-form self) form)
    71         (send scrollview :set-document-view form)
     70        (#/setDocumentView: scrollview form)
    7271        form))))
    7372
     
    7675                         (apply #'vector (reverse (cocoa-defaults)))))
    7776         (form (create-prefs-view-form self))
    78          (domain (setf (prefs-view-domain self) (send (@class "NSUserDefaults") 'standard-user-defaults)))
     77         (domain (setf (prefs-view-domain self) (#/standardUserDefaults ns:ns-user-defaults)))
    7978         (n (length defaults)))
    8079    (setf (prefs-view-nvalues self) n)
     
    8281      (let* ((d (svref defaults i))
    8382             (key (objc-constant-string-nsstringptr (cocoa-default-string d)))
    84              (val (send domain :object-for-key key)))
     83             (val (#/objectForKey: domain key)))
    8584        (when (%null-ptr-p val)
    86           (send domain
    87                 :set-object (setq val (%make-nsstring (format nil "~a" (cocoa-default-value d))))
    88                 :for-key key))
     85          (#/setObject:forKey:
     86           domain (setq val (%make-nsstring (format nil "~a" (cocoa-default-value d)))) key))
    8987        (set-prefs-cell-from-default self
    90                                      (send form :add-entry key)
     88                                     (#/addEntry: form key)
    9189                                     d
    9290                                     form
     
    9492                                     i)))
    9593    (setf (prefs-view-nchanges self) 0)
    96     (send (prefs-view-revert-button self) :set-enabled nil)
    97     (send (prefs-view-commit-button self) :set-enabled nil)
    98     (send form 'size-to-cells)))
     94    (#/setEnabled: (prefs-view-revert-button self) nil)
     95    (#/setEnabled: (prefs-view-commit-button self) nil)
     96    (#/sizeToCells form)))
    9997
    10098(objc:defmethod (#/notePrefsChange: :void) ((self prefs-view) form)
     
    107105         (value (#/stringValue cell)))
    108106    (unless (#/isEqualTo: value
    109                           (#/objectForKey (prefs-view-domain self)
    110                                           (objc-constant-string-nsstringptr (cocoa-default-string d))))
     107                          (#/objectForKey: (prefs-view-domain self)
     108                                           (objc-constant-string-nsstringptr (cocoa-default-string d))))
    111109      ;; If there's a constraint, sanity-check the value.
    112110      (when (zerop (prefs-view-nchanges self))
    113111        (#/setEnabled: (prefs-view-commit-button self) t)
    114         (#/setEnabled  (prefs-view-revert-button self) t))
     112        (#/setEnabled:  (prefs-view-revert-button self) t))
    115113      (incf (prefs-view-nchanges self)))
    116114    (#/selectCell: form (#/cellAtIndex: form next))))
     
    144142
    145143 
    146 (define-objc-method ((:id :init-with-frame (:<NSR>ect frame))
    147                      prefs-view)
    148   (send-super :init-with-frame frame)
    149   (slet ((scroll-frame (ns-make-rect (float 20.0f0 +cgfloat-zero+)
    150                                      (float 40.0f0 +cgfloat-zero+)
    151                                      (- (pref frame :<NSR>ect.size.width) 40.0f0)
    152                                      (- (pref frame :<NSR>ect.size.height) 60.0f0))))
    153     (let* ((scrollview (make-objc-instance 'ns:ns-scroll-view
    154                                            :with-frame scroll-frame))
    155            (scroll-content (send scrollview 'content-view)))
    156       (send scrollview :set-border-type #$NSBezelBorder)
    157       (send scrollview :set-has-vertical-scroller t)
    158       (send scrollview :set-has-horizontal-scroller t)
    159       (send scrollview :set-rulers-visible nil)
    160       (send scrollview :set-autoresizing-mask (logior
    161                                                #$NSViewWidthSizable
    162                                                #$NSViewHeightSizable))
    163       (send scroll-content :set-autoresizes-subviews t)
     144(objc:defmethod #/initWithFrame: ((self prefs-view) (frame :<NSR>ect))
     145  (call-next-method frame)
     146  (rlet ((scroll-frame :ns-rect))
     147    (ns:init-ns-rect scroll-frame 20 40 (- (ns:ns-rect-width frame) 40) (- (ns:ns-rect-height frame) 60))
     148    (let* ((scrollview (make-instance 'ns:ns-scroll-view
     149                                      :with-frame scroll-frame))
     150           (scroll-content (#/contentView scrollview)))
     151      (#/setBorderType: scrollview #$NSBezelBorder)
     152      (#/setHasVerticalScroller: scrollview t)
     153      (#/setHasHorizontalScroller: scrollview t)
     154      (#/setRulersVisible: scrollview nil)
     155      (#/setAutoresizingMask: scrollview (logior
     156                                          #$NSViewWidthSizable
     157                                          #$NSViewHeightSizable))
     158      (#/setAutoresizesSubviews: scroll-content t)
    164159      (setf (slot-value self 'scroll-view) scrollview)
    165       (slet ((revert-frame (ns-make-rect (float 20.0f0 +cgfloat-zero+)
    166                                          (float 10.0f0 +cgfloat-zero+)
    167                                          (float 80.0f0 +cgfloat-zero+)
    168                                          (float 20.0f0 +cgfloat-zero+)))
    169              (commit-frame (ns-make-rect (- (+ (pref frame :<NSR>ect.origin.x)
    170                                                (pref frame :<NSR>ect.size.width))
    171                                             (+ 80.0f0 20.0f0))
    172                                          (float 10.0f0 +cgfloat-zero+)
    173                                          (float 80.0f0 +cgfloat-zero+)
    174                                          (float 20.0f0 +cgfloat-zero+))))
    175         (let* ((commit-button (make-objc-instance
     160      (rlet ((revert-frame :ns-rect)
     161             (commit-frame :ns-rect))
     162        (ns:init-ns-rect revert-frame 20 10 80 20)
     163        (ns:init-ns-rect commit-frame (- (+ (ns:ns-rect-x frame)
     164                                             (ns:ns-rect-width frame))
     165                                          (+ 80.0f0 20.0f0)) 10 70 20)
     166        (let* ((commit-button (make-instance
    176167                               'ns:ns-button
    177168                               :with-frame commit-frame))
    178                (revert-button (make-objc-instance
     169               (revert-button (make-instance
    179170                               'ns:ns-button
    180171                               :with-frame revert-frame)))
    181           (send commit-button :set-title #@"Commit")
    182           (send revert-button :set-title #@"Revert")
    183           (send commit-button :set-enabled nil)
    184           (send revert-button :set-enabled nil)
    185           (send commit-button :set-action (@selector "commitPrefs:"))
    186           (send commit-button :set-target self)
    187           (send revert-button :set-action (@selector "revertPrefs:"))
    188           (send revert-button :set-target self)
    189           (send commit-button :set-autoresizing-mask #$NSViewMinXMargin)
    190           (send revert-button :set-autoresizing-mask #$NSViewMaxXMargin)
    191           (send revert-button :set-bezel-style #$NSRoundedBezelStyle)
    192           (send commit-button :set-bezel-style #$NSRoundedBezelStyle)
     172          (#/setTitle: commit-button #@"Commit")
     173          (#/setTitle: revert-button #@"Revert")
     174          (#/setEnabled: commit-button nil)
     175          (#/setEnabled: revert-button nil)
     176          (#/setAction: commit-button (@selector "commitPrefs:"))
     177          (#/setTarget: commit-button self)
     178          (#/setAction: revert-button (@selector "revertPrefs:"))
     179          (#/setTarget: revert-button self)
     180          (#/setAutoresizingMask: commit-button #$NSViewMinXMargin)
     181          (#/setAutoresizingMask: revert-button #$NSViewMaxXMargin)
     182          (#/setBezelStyle: revert-button #$NSRoundedBezelStyle)
     183          (#/setBezelStyle: commit-button #$NSRoundedBezelStyle)
    193184          (setf (prefs-view-revert-button self) revert-button
    194185                (prefs-view-commit-button self) commit-button)
    195           (send self :add-subview revert-button)
    196           (send self :add-subview commit-button)
    197           (send self :add-subview scrollview)
     186          (#/addSubview: self revert-button)
     187          (#/addSubview: self commit-button)
     188          (#/addSubview: self scrollview)
    198189          self)))))
    199190
     
    221212  (let* ((class (class-of self)))
    222213    (#/dealloc self)
    223     (send class 'shared-panel)))
     214    (#/sharedPanel class)))
    224215
    225216(objc:defmethod (#/show :void) ((self preferences-panel))
    226217  (init-prefs-form-from-defaults (preferences-panel-prefs-view self))
    227   (#/makeKeyAndOrderFront: self (%null-ptr)))
     218  (#/makeKeyAndOrderFront: self +null-ptr+))
     219
  • branches/objc-gf/ccl/examples/cocoa-typeout.lisp

    r6105 r6130  
    3131  (:metaclass ns:+ns-object))
    3232
    33 (define-objc-method ((:id :init-with-frame (:<NSR>ect frame))
    34                      typeout-view)
    35   (send-super :init-with-frame frame)
    36   (let* ((scrollview (make-objc-instance 'ns:ns-scroll-view
    37                                          :with-frame frame))
    38          (scroll-content (send scrollview 'content-view)))
    39     (send scrollview :set-border-type #$NSBezelBorder)
    40     (send scrollview :set-has-vertical-scroller t)
    41     (send scrollview :set-has-horizontal-scroller nil)
    42     (send scrollview :set-rulers-visible nil)
    43     (send scrollview :set-autoresizing-mask #$NSViewHeightSizable)
    44     (send scroll-content :set-autoresizes-subviews t)
    45     (send self :add-subview scrollview)
     33(objc:defmethod #/initWithFrame: ((self typeout-view) (frame :<NSR>ect))
     34  (call-next-method frame)
     35  (let* ((scrollview (make-instance 'ns:ns-scroll-view
     36                                    :with-frame frame))
     37         (scroll-content (#/contentView scrollview)))
     38    (#/setBorderType: scrollview #$NSBezelBorder)
     39    (#/setHasVerticalScroller: scrollview t)
     40    (#/setHasHorizontalScroller: scrollview nil)
     41    (#/setRulersVisible: scrollview nil)
     42    (#/setAutoresizingMask: scrollview #$NSViewHeightSizable)
     43    (#/setAutoresizesSubviews: scroll-content t)
     44    (#/addSubview: self scrollview)
    4645    (setf (slot-value self 'scroll-view) scrollview)
    47     (slet* ((contentsize (send scrollview 'content-size))
    48             (text-frame (ns-make-rect
    49                          +cgfloat-zero+
    50                          +cgfloat-zero+
    51                          (pref contentsize :<NSS>ize.width)
    52                          (pref contentsize :<NSS>ize.height))))
    53            (let* ((text-view (make-objc-instance 'ns:ns-text-view
    54                                             :with-frame text-frame))
    55                   (text-storage (send text-view 'text-storage)))
    56              (send text-view :set-editable 0)
    57              (setf (slot-value self 'text-storage) text-storage)
    58              (send scrollview :set-document-view text-view)
    59              (setf (slot-value self 'text-view) text-view))))
     46    (let* ((contentsize (#/contentSize scrollview)))
     47      (rlet ((text-frame :ns-rect))
     48        (ns:init-ns-rect text-frame 0 0 (ns:ns-size-width contentsize) (ns:ns-size-height contentsize))
     49        (let* ((text-view (make-instance 'ns:ns-text-view
     50                                         :with-frame text-frame))
     51               (text-storage (#/textStorage text-view)))
     52          (#/setEditable: text-view nil)
     53          (setf (slot-value self 'text-storage) text-storage)
     54          (#/setDocumentView: scrollview text-view)
     55          (setf (slot-value self 'text-view) text-view)))))
    6056  self)
    6157
     
    6965  (:metaclass ns:+ns-object))
    7066
    71 (define-objc-class-method ((:id shared-panel)
    72                            typeout-panel)
     67(objc:defmethod #/sharedPanel ((self +typeout-panel))
    7368  (cond (*typeout-panel*)
    7469        (t
     
    7772                                         :width 600
    7873                                         :activate nil)))
    79            (rlet ((size :<NSS>ize
    80                     :width (float 600.0f0 +cgfloat-zero+)
    81                     :height (float 10000.0f0 +cgfloat-zero+)))
    82                  (send panel :set-max-size size)
    83                  (setf (pref size :<NSS>ize.height) (float 1.0f0 +cgfloat-zero+))
    84                  (send panel :set-min-size size))
    85            (slet ((bounds (send (send panel 'content-view) 'bounds)))
    86                  (let* ((view (make-instance 'typeout-view :with-frame bounds)))
    87                    (send panel :set-content-view view)
    88                    (send view :set-needs-display t)
    89                    (setf (slot-value panel 'typeout-view) view)
    90                    (setq *typeout-panel* panel)))))))
     74           (rlet ((size :<NSS>ize))
     75             (ns:init-ns-size size 600 10000)
     76             (#/setMaxSize: panel size)
     77             (setf (ns:ns-size-height size) 1)
     78             (#/setMinSize: panel size))
     79           (let* ((view (make-instance 'typeout-view :with-frame (#/bounds (#/contentView panel)))))
     80             (#/setContentView: panel view)
     81             (#/setNeedsDisplay: view t)
     82             (setf (slot-value panel 'typeout-view) view)
     83             (setq *typeout-panel* panel))))))
    9184
    92 (define-objc-method ((:id init)
    93                      typeout-panel)
     85(objc:defmethod #/init ((self typeout-panel))
    9486  (let* ((class (class-of self)))
    95     (send self 'dealloc)
    96     (send class 'shared-panel)))
     87    (#/dealloc self)
     88    (#/sharedPanel class)))
    9789
    98 (define-objc-method ((:void show)
    99                      typeout-panel)
    100   (send self :order-front (%null-ptr)))
     90
     91(objc:defmethod (#/show :void) ((self typeout-panel))
     92  (#/orderFront: self +null-ptr+))
    10193
    10294(defloadvar *typeout-attributes* nil)
     
    108100
    109101(defun prepare-typeout-stream (stream)
    110   (let ((panel (send (@class typeout-panel) 'shared-panel)))
     102  (let ((panel (#/sharedPanel typeout-panel)))
    111103    (unless (typeout-stream-text-storage stream)
    112104      (setf (typeout-stream-text-storage stream) (typeout-view-text-storage (typeout-panel-typeout-view panel))))
     
    115107                                  :font (default-font :name *default-font-name* :size *default-font-size*)
    116108                                  :line-break-mode :word)))
    117     (send panel 'show)))
     109    (#/show panel)))
    118110
    119111
     
    157149                                  :with-string str
    158150                                  :attributes *typeout-attributes*)))
    159     (send text-storage :append-attributed-string attr-str)))
     151    (#/appendAttributedString: text-storage attr-str)))
    160152
    161153(defmethod stream-write-string ((stream typeout-stream) string &optional (start 0) end)
     
    170162         (text-storage (slot-value the-typeout-view 'text-storage)))
    171163    (setf (typeout-stream-line-position stream) (length string))
    172     (send text-storage :append-attributed-string attr-str)))
     164    (#/appendAttributedString: text-storage attr-str)))
    173165
    174166(defmethod stream-fresh-line ((stream typeout-stream))
     
    183175  (let* ((the-typeout-view (typeout-panel-typeout-view *typeout-panel*))
    184176         (text-storage (slot-value the-typeout-view 'text-storage))
    185          (len (send text-storage 'length)))
     177         (len (#/length text-storage)))
    186178    (declare (type ns:ns-text-storage text-storage))
    187     (send text-storage :delete-characters-in-range (ns-make-range 0 len))))
     179    (rlet ((range-for-deletion :ns-range :location 0 :length len))
     180      (#/deleteCharactersInRange: text-storage range-for-deletion))))
    188181
    189182(defloadvar *typeout-stream* (make-instance 'typeout-stream))
  • branches/objc-gf/ccl/examples/cocoa-window.lisp

    r6112 r6130  
    3939      (let* ((bundle (open-main-bundle))
    4040             (dict (#/infoDictionary  bundle))
    41              (classname (#/objectForKey dict #@"NSPrincipalClass"))
     41             (classname (#/objectForKey: dict #@"NSPrincipalClass"))
    4242             (mainnibname (#/objectForKey: dict  #@"NSMainNibFile"))
    4343             (progname (#/objectForKey: dict #@"CFBundleName")))
     
    4747          (error "problems loading bundle: can't determine main nib name"))
    4848        (unless (%null-ptr-p progname)
    49           (#/setProcessName (#/processInfo ns:ns-process-info)))
     49          (#/setProcessName: (#/processInfo ns:ns-process-info) progname))
    5050        (let* ((appclass (#_NSClassFromString classname))
    5151               (app (#/sharedApplication appclass)))
     
    102102                   0.0d0
    103103                   0
    104                    (%null-ptr)
     104                   +null-ptr+
    105105                   process-interrupt-event-subtype
    106106                   (register-appkit-process-interrupt
     
    124124;;; type is #$NSApplicationDefined.
    125125(objc:defmethod (#/sendEvent: :void) ((self lisp-application) e)
    126   (if (and (eql (#/type e #$NSApplicationDefined)
    127            (eql (#/subtype e  process-interrupt-event-subtype))
     126  (if (and (eql (#/type e) #$NSApplicationDefined)
     127           (eql (#/subtype e)  process-interrupt-event-subtype))
    128128    ;;; The thunk to funcall is identified by the value
    129129    ;;; of the event's data1 attribute.
     
    134134(objc:defmethod (#/showPreferences: :void) ((self lisp-application) sender)
    135135  (declare (ignore sender))
    136   (#/show (#/sharedPanel preferenes-panel)))
     136  (#/show (#/sharedPanel preferences-panel)))
    137137
    138138(objc:defmethod (#/toggleTypeout: :void) ((self lisp-application) sender)
     
    150150  (when (eq process *initial-process*)
    151151    (%set-toplevel thunk)
    152     (#/terminate: *NSApp* (%null-ptr))))
     152    (#/terminate: *NSApp* +null-ptr+)))
    153153
    154154(defun run-event-loop ()
     
    182182             (let* ((icon (#/imageNamed: ns:ns-image #@"NSApplicationIcon")))
    183183               (unless (%null-ptr-p icon)
    184                  (#/setApplicationIconImage *NSApp* icon)))
     184                 (#/setApplicationIconImage: *NSApp* icon)))
    185185             (setf (application-ui-object *application*) *NSApp*)
    186186             (when application-proxy-class-name
     
    247247;;; Create a paragraph style, mostly so that we can set tabs reasonably.
    248248(defun create-paragraph-style (font line-break-mode)
    249   (let* ((p (make-objc-instance 'ns-mutable-paragraph-style))
     249  (let* ((p (make-instance 'ns:ns-mutable-paragraph-style))
    250250         (charwidth (fround (ns:ns-size-width (#/maximumAdvancement font)))))
    251251    (#/setLineBreakMode: p
     
    259259    (do* ((i 1 (1+ i)))
    260260         ((= i 100) p)
    261       (let* ((tabstop (make-objc-instance
    262                        'ns-text-tab
     261      (let* ((tabstop (make-instance
     262                       'ns:ns-text-tab
    263263                       :with-type #$NSLeftTabStopType
    264264                       :location  (* (* i *tab-width*)
     
    272272                                    (obliqueness nil)
    273273                                    (stroke-width nil))
    274   (let* ((dict (make-objc-instance
    275                 'ns-mutable-dictionary
    276                 :with-capacity 5)))
    277     (#/retain dict)
     274  (let* ((dict (#/retain (make-instance 'ns:ns-mutable-dictionary :with-capacity 5))))
    278275    (#/setObject:forKey: dict (create-paragraph-style font line-break-mode) #&NSParagraphStyleAttributeName)
    279276    (#/setObject:forKey: dict font #&NSFontAttributeName)
     
    281278      (#/setObject:forKey: dict color #&NSForegroundColorAttributeName))
    282279    (when stroke-width
    283       (#/setObject:forKey: dict (make-objc-instance 'ns:ns-number
    284                                                     :with-float (float stroke-width)) #&NSStrokeWidthAttributeName))
     280      (#/setObject:forKey: dict (make-instance 'ns:ns-number
     281                                               :with-float (float stroke-width)) #&NSStrokeWidthAttributeName))
    285282    (when obliqueness
    286       (#/setObject:forKey:  dict (make-objc-instance 'ns:ns-number
    287                                                      :with-float (float obliqueness)) #&NSObliquenessAttributeName))
     283      (#/setObject:forKey:  dict (make-instance 'ns:ns-number
     284                                                :with-float (float obliqueness)) #&NSObliquenessAttributeName))
    288285    dict))
    289286
  • branches/objc-gf/ccl/examples/cocoa.lisp

    r6112 r6130  
    3939(objc:defmethod (#/newListener: :void) ((self lisp-application-delegate)
    4040                                        sender)
     41  (declare (ignore sender))
    4142  (#/openUntitledDocumentOfType:display:
    4243   (#/sharedDocumentController ns:ns-document-controller)
     
    5354
    5455(objc:defmethod (#/applicationOpenUntitledFile: :<BOOL>)
    55     ((self lisp-application-delegate app))
     56    ((self lisp-application-delegate) app)
    5657  (when (zerop *cocoa-listener-count*)
    5758    (#/newListener: self app)
     
    8687  (ui-object-exit-backtrace-context o (car args)))
    8788
    88 
    8989(start-cocoa-application)
    9090
  • branches/objc-gf/ccl/examples/name-translation.lisp

    r6057 r6130  
    189189
    190190
    191 (defun compute-objc-to-lisp-function-name (str &optional (package "NS"))
     191(defun compute-objc-to-lisp-function-name (str &optional (package "NSFUN"))
    192192  #-nil
    193193  (intern str package)
  • branches/objc-gf/ccl/examples/objc-clos.lisp

    r6078 r6130  
    120120       (raw-macptr-for-instance instance))))
    121121
     122
    122123(defun recognize-objc-object (p)
    123   (let* ((idx (objc-class-id p)))
    124     (if idx
    125       (%set-macptr-type p (dpb objc-flag-class objc-type-flags idx))
    126       (if (setq idx (objc-metaclass-id p))
    127         (%set-macptr-type p (dpb objc-flag-metaclass objc-type-flags idx))
    128         (if (setq idx (%objc-instance-class-index p))
    129           (%set-macptr-type p idx))))))
     124  (labels ((recognize (p mapped)
     125             (let* ((idx (objc-class-id p)))
     126               (if idx
     127                 (%set-macptr-type p (dpb objc-flag-class objc-type-flags idx))
     128                 (if (setq idx (objc-metaclass-id p))
     129                   (%set-macptr-type p (dpb objc-flag-metaclass objc-type-flags idx))
     130                   (if (setq idx (%objc-instance-class-index p))
     131                     (%set-macptr-type p idx)
     132                     (unless mapped
     133                       (if (maybe-map-objc-classes)
     134                         (recognize p t)))))))))
     135    (recognize p nil)))
    130136
    131137(defun release-canonical-nsobject (object)
     
    413419        (with-cstrs ((name string)
    414420                     (encoding encoding))
    415           (unless (eql #$NO (#_class_addIvar class name size align encoding))
    416             (with-macptrs ((ivar (#_class_getInstanceVariable class name)))
     421          (#_class_addIvar class name size align encoding)
     422          (with-macptrs ((ivar (#_class_getInstanceVariable class name)))
    417423              (unless (%null-ptr-p ivar)
    418424                (let* ((offset (#_ivar_getOffset ivar)))
    419425                  (setf (foreign-direct-slot-definition-bit-offset dslotd)
    420                         (ash offset 3)))))))))))
     426                        (ash offset 3))))))))))
    421427
    422428                                               
     
    742748            (send-objc-init-message (allocate-objc-object class) ks vs))))
    743749    (unless (%null-ptr-p instance)
    744       (let* ((raw-ptr (raw-macptr-for-instance instance))
    745              (slot-vector (create-foreign-instance-slot-vector class)))
     750      (let* ((slot-vector (create-foreign-instance-slot-vector class)))
    746751        (when slot-vector
    747           (setf (slot-vector.instance slot-vector) raw-ptr)
    748           (setf (gethash raw-ptr *objc-object-slot-vectors*) slot-vector))
    749         (register-canonical-objc-instance instance raw-ptr)))))
     752          (let* ((raw-ptr (raw-macptr-for-instance instance)))
     753            (setf (slot-vector.instance slot-vector) raw-ptr)
     754            (setf (gethash raw-ptr *objc-object-slot-vectors*) slot-vector)
     755            (register-canonical-objc-instance instance raw-ptr))))
     756      instance)))
    750757
    751758(defmethod terminate ((instance objc:objc-object))
  • branches/objc-gf/ccl/examples/objc-package.lisp

    r6112 r6130  
    1616;;;
    1717
     18(in-package "CCL")
     19
    1820;;; All class names and instance variable names are interned in the NS package
    1921;;; Force all symbols interned in the NS package to be external
    2022
    2123(defpackage "NS"
    22   (:use))
     24  (:use)
     25  (:export "+CGFLOAT-ZERO+" "CGFLOAT"))
    2326
    2427(eval-when (:compile-toplevel :load-toplevel :execute)
    2528  (package-force-export "NS"))
    2629
     30;;; ObjC function names (as produced by #/) are interned in NSF.
     31(defpackage "NEXTSTEP-FUNCTIONS"
     32  (:use)
     33  (:nicknames "NSFUN"))
     34
     35(eval-when (:compile-toplevel :load-toplevel :execute)
     36  (package-force-export "NSFUN"))
    2737
    2838(defpackage "OBJC"
    2939  (:use)
    3040  (:export "OBJC-OBJECT" "OBJC-CLASS-OBJECT" "OBJC-CLASS" "OBJC-METACLASS"
    31            "DEFMETHOD"))
     41           "@CLASS" "@SELECTOR" "MAKE-OBJC-INSTANCE"
     42           "DEFMETHOD" "SLET" "SEND" "SEND/STRET" "SEND-SUPER" "SEND-SUPER/STRET"))
    3243
    3344
     45(eval-when (:compile-toplevel :load-toplevel :execute)
     46  (import '(objc:@class objc:@selector objc:make-objc-instance
     47            objc:send objc:send/stret objc:send-super objc:send-super/stret
     48            ns:+cgfloat-zero+ ns:cgfloat)
     49          "CCL"))
     50
    3451(provide "OBJC-PACKAGE")
  • branches/objc-gf/ccl/examples/objc-runtime.lisp

    r6112 r6130  
    10221022  (let ((x-temp (gensym)))
    10231023    `(let ((,x-temp ,x))
    1024        (cond ((null ,x-temp) (%null-ptr))
     1024       (cond ((null ,x-temp) +null-ptr+)
    10251025             ((stringp ,x-temp) (%make-nsstring ,x-temp))
    10261026             (t ,x-temp)))))
     
    23702370            (arg-names)
    23712371            (arg-types)
    2372             (bool-args))
     2372            (bool-args)
     2373            (type-assertions))
    23732374    (let* ((result-type nil)
    23742375           (selector nil)
     
    23952396              (arg-names arg))
    23962397            (destructuring-bind (arg-name arg-type) arg
    2397               (arg-types (concise-foreign-type arg-type))
    2398               (arg-names arg-name))))
     2398              (let* ((concise-type (concise-foreign-type arg-type)))
     2399                (unless (eq concise-type :id)
     2400                  (let* ((ftype (parse-foreign-type concise-type)))
     2401                    (if (typep ftype 'foreign-pointer-type)
     2402                      (setq ftype (foreign-pointer-type-to ftype)))
     2403                    (if (and (typep ftype 'foreign-record-type)
     2404                             (foreign-record-type-name ftype))
     2405                      (type-assertions `(%set-macptr-type ,arg-name
     2406                                         (foreign-type-ordinal (load-time-value (%foreign-type-or-record ,(foreign-record-type-name ftype)))))))))
     2407                (arg-types concise-type)
     2408                (arg-names arg-name)))))
    23992409        (let* ((arg-names (arg-names))
    24002410               (arg-types (arg-types)))
     
    24132423                                          selector)))
    24142424                 (typestring (encode-objc-method-arglist arg-types result-type))
    2415                  (signature
    2416                   (%declare-objc-method selector
    2417                                         objc-class-name
    2418                                         class-p
    2419                                         result-type
    2420                                         (cddr arg-types))))
     2425                 (signature (cons result-type (cddr arg-types))))
    24212426            (multiple-value-bind (body decls) (parse-body body env)
    24222427             
    2423               (setq body `((progn ,@(bool-args) ,@body)))
     2428              (setq body `((progn ,@(bool-args) ,@(type-assertions) ,@body)))
    24242429              (if (eq result-type :<BOOL>)
    24252430                (setq body `((%coerce-to-bool ,@body))))
     
    24372442                                 ,@body)))
    24382443              `(progn
     2444                (%declare-objc-method
     2445                 ',selector
     2446                 ',objc-class-name
     2447                 ,class-p
     2448                 ',result-type
     2449                 ',(cddr arg-types))
    24392450                (defcallback ,impname ( :error-return (condition objc-callback-error-return) ,@(arglist))
    24402451                  (declare (ignorable ,self-name ,cmd)
  • branches/objc-gf/ccl/examples/objc-support.lisp

    r6112 r6130  
    2424           ((= i n) (values))
    2525        (declare (fixnum i))
    26         (funcall fn (%get-ptr buffer (the fixnum  (ash i target::word-shift))))))))
     26        (funcall fn (paref buffer (:* :id) i))))))
     27
     28#+apple-objc
     29(defun count-objc-classes ()
     30  (#_objc_getClassList (%null-ptr) 0)) 
    2731
    2832#+gnu-objc
     
    3438          (return)
    3539          (funcall fn class))))))
     40
     41#+gnu-objc
     42(defun count-objc-classes ()
     43  (let* ((n 0))
     44    (declare (fixnum n))
     45    (rletZ ((enum-state :address))
     46      (if (%null-ptr-p (#_objc_next_class enum-state))
     47        (return n)
     48        (incf n)))))
    3649
    3750(defun %note-protocol (p)
     
    7588       (note-class-protocols class)
    7689       (install-foreign-objc-class class lookup-in-database-p))))
    77  
    78 
    79 (map-objc-classes)
     90
     91(let* ((nclasses 0))
     92  (declare (fixnum nclasses))
     93  (defun maybe-map-objc-classes ()
     94    (let* ((new (count-objc-classes)))
     95      (declare (fixnum new))
     96    (unless (= nclasses new)
     97      (setq nclasses new)
     98      (map-objc-classes)
     99      t))))
     100
     101(maybe-map-objc-classes)
    80102(register-objc-init-messages)
    81103
     
    128150
    129151(objc:defmethod #/init ((self ns-lisp-exception))
    130   (#/initWithName:reason:userInfo: self #@"lisp exception" #@"lisp exception" (%null-ptr)))
     152  (#/initWithName:reason:userInfo: self #@"lisp exception" #@"lisp exception" +null-ptr+))
    131153
    132154
     
    177199  ;;; this condition.
    178200
    179   #|(dbg (format nil "~a" c))|#
     201  (dbg (format nil "~a" c))
    180202  ;;(#_NSLog #@"Lisp exception: %@" :id (%make-nsstring (format nil "~a" c)))
    181203  (make-instance 'ns-lisp-exception :condition c))
     
    276298              (#/addObject: values newval)
    277299              (return)))))
    278     (make-objc-instance 'ns-dictionary
    279                         :with-objects values
    280                         :for-keys keys)))
     300    (make-instance 'ns:ns-dictionary
     301                   :with-objects values
     302                   :for-keys keys)))
    281303
    282304
     
    293315(defun lisp-string-from-nsstring-substring (nsstring start length)
    294316  (%stack-block ((cstring (1+ length)))
    295     (send nsstring
    296           :get-c-string cstring
    297           :max-length length
    298           :range (ns-make-range start length)
    299           :remaining-range (%null-ptr))
    300     (%get-cstring cstring)))
     317    (rlet ((range :ns-range :location start :length length))
     318      (#/getCString:maxLength:range:remainingRange:
     319       nsstring  cstring  length range +null-ptr+)
     320      (%get-cstring cstring))))
    301321
    302322(def-standard-initial-binding *listener-autorelease-pool* nil)
  • branches/objc-gf/ccl/examples/webkit.lisp

    r5884 r6130  
    6565                         (url-from-string urlspec)))
    6666                ;; Create a window with titlebar, close & iconize buttons
    67                 (w (make-objc-instance
     67                (w (make-instance
    6868                    'ns:ns-window
    6969                    :with-content-rect r
     
    7878           (send w :set-title (send (the ns-url url) 'absolute-string))
    7979           ;; Create a web-view instance,
    80            (let* ((v (make-objc-instance
     80           (let* ((v (make-instance
    8181                      'web-view
    8282                      :with-frame r
Note: See TracChangeset for help on using the changeset viewer.