Changeset 6232


Ignore:
Timestamp:
Apr 8, 2007, 5:05:39 PM (13 years ago)
Author:
gb
Message:

Use new syntax: OBJC:DEFMETHOD, #/, MAKE-INSTANCE.

Use OBJC:LOAD-FRAMEWORK.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/examples/webkit.lisp

    r5884 r6232  
    55
    66(eval-when (:compile-toplevel :load-toplevel :execute)
    7   (require "COCOA")
    8   (augment-objc-interfaces :webkit)
    9   )
    10 
    11 ;;; Create web browser objects, via the OSX WebKit.
    12 ;;; WebKit is bundled with versions of OSX >= 10.3; it is (or was)
    13 ;;; also available as part of Safari 1.0 (for OSX 10.2).
    14 ;;; Some very old versions had a bug which rendered NSTextViews
    15 ;;; inoperable if WebKit was loaded after an NSTextView had been
    16 ;;; created.
    17 
    18 (let* ((checked-for-webkit nil)
    19        (webkit-loaded nil))
    20   (defun reset-checked-for-webkit ()
    21     (setq checked-for-webkit nil
    22           webkit-loaded nil))
    23   (defun check-for-webkit ()
    24     (if checked-for-webkit
    25       webkit-loaded
    26       (setq checked-for-webkit t
    27             webkit-loaded (load-objc-extension-framework "WebKit")))))
    28 
    29 (defun require-webkit ()
    30   (or (check-for-webkit)
    31       (error "The WebKit framework doesn't seem to be installed on this machine.~&
    32               It's available as part of Safari 1.0.")))
     7  (require "COCOA"))
    338
    349(eval-when (:compile-toplevel :load-toplevel :execute)
    35   (require-webkit))
     10  (objc:load-framework "WebKit" :webkit))
     11
    3612
    3713(defun pathname-to-file-url (pathname)
     
    4117  ;; were escaped in NAMESTRING's result.)
    4218  (with-autorelease-pool
    43    (send       
    44     (send (@class "NSURL")
    45           :file-url-with-path (%make-nsstring
    46                                (native-translated-namestring pathname)))
    47     'retain)))
     19    (#/retain
     20     (#/fileURLWithPath: ns:ns-url (%make-nsstring
     21                                    (native-translated-namestring pathname))))))
    4822
    4923(defun url-from-string (s)
    5024  (with-autorelease-pool
    51    (send
    52     (send (@class "NSURL") "URLWithString:" (%make-nsstring (string s)))
    53     'retain)))
     25    (#/retain (#/URLWithString: ns:ns-url (%make-nsstring (string s))))))
    5426                 
    5527
    5628(defun browser-window (urlspec)
    5729  ;; Content rect for window, bounds rect for view.
    58   (slet ((r (ns-make-rect (float 100.0 +cgfloat-zero+)
    59                           (float 100.0 +cgfloat-zero+)
    60                           (float 800.0 +cgfloat-zero+)
    61                           (float 600.0 +cgfloat-zero+))))
    62         (with-autorelease-pool
    63          (let* ((url (if (typep urlspec 'pathname)
    64                          (pathname-to-file-url urlspec)
    65                          (url-from-string urlspec)))
    66                 ;; Create a window with titlebar, close & iconize buttons
    67                 (w (make-objc-instance
    68                     'ns:ns-window
    69                     :with-content-rect r
    70                     :style-mask (logior #$NSTitledWindowMask
    71                                         #$NSClosableWindowMask
    72                                         #$NSMiniaturizableWindowMask
    73                                         #$NSResizableWindowMask)
    74                     ;; Backing styles other than #$NSBackingStoreBuffered
    75                     ;; don't work at all in Cocoa.
    76                     :backing #$NSBackingStoreBuffered
    77                     :defer t)))
    78            (send w :set-title (send (the ns-url url) 'absolute-string))
    79            ;; Create a web-view instance,
    80            (let* ((v (make-objc-instance
    81                       'web-view
    82                       :with-frame r
    83                       :frame-name #@"frame"     ; could be documented a bit better ...
    84                       :group-name #@"group"))) ; as could this
    85              ;; Make the view be the window's content view.
    86              (send w :set-content-view v)
    87              ;; Start a URL request.  The request is processed
    88              ;; asynchronously, but apparently needs to be initiated
    89              ;; from the event-handling thread.
    90              (let* ((webframe (send (the web-view v) 'main-frame))
    91                     (request (send (@class "NSURLRequest") :request-with-url url)))
    92                (send (the web-frame webframe)
    93                      :perform-selector-on-main-thread
    94                      (@selector "loadRequest:")
    95                      :with-object  request
    96                      ;; Failing to wait until the main thread has
    97                      ;; initiated the request seems to cause
    98                      ;; view-locking errors.  Maybe that's just
    99                      ;; an artifact of some other problem.
    100                      :wait-until-done t)
    101                ;; Make the window visible & activate it
    102                ;; The view knows how to draw itself and respond
    103                ;; to events.
    104                (send w :make-key-and-order-front nil))
    105              v)))))
     30  (ns:with-ns-rect (r 100.0 100.0 800.0 600.0)
     31    (with-autorelease-pool
     32      (let* ((url (if (typep urlspec 'pathname)
     33                    (pathname-to-file-url urlspec)
     34                    (url-from-string urlspec)))
     35             ;; Create a window with titlebar, close & iconize buttons
     36             (w (make-instance
     37                 'ns:ns-window
     38                 :with-content-rect r
     39                 :style-mask (logior #$NSTitledWindowMask
     40                                     #$NSClosableWindowMask
     41                                     #$NSMiniaturizableWindowMask
     42                                     #$NSResizableWindowMask)
     43                 ;; Backing styles other than #$NSBackingStoreBuffered
     44                 ;; don't work at all in Cocoa.
     45                 :backing #$NSBackingStoreBuffered
     46                 :defer t)))
     47        (#/setTitle: w (#/absoluteString url))
     48        ;; Create a web-view instance,
     49        (let* ((v (make-instance
     50                   'ns:web-view
     51                   :with-frame r
     52                   :frame-name #@"frame" ; could be documented a bit better ...
     53                   :group-name #@"group"))) ; as could this
     54          ;; Make the view be the window's content view.
     55          (#/setContentView: w v)
     56          ;; Start a URL request.  The request is processed
     57          ;; asynchronously, but apparently needs to be initiated
     58          ;; from the event-handling thread.
     59          (let* ((webframe (#/mainFrame v))
     60                 (request (#/requestWithURL: ns:ns-url-request url)))
     61            ;; Failing to wait until the main thread has
     62            ;; initiated the request seems to cause
     63            ;; view-locking errors.  Maybe that's just
     64            ;; an artifact of some other problem.
     65            (#/performSelectorOnMainThread:withObject:waitUntilDone:
     66             webframe (@selector #/loadRequest:) request t)
     67            ;; Make the window visible & activate it
     68            ;; The view knows how to draw itself and respond
     69            ;; to events.
     70            (#/makeKeyAndOrderFront: w +null-ptr+))
     71          v)))))
    10672       
    10773;;; (browser-window "http://openmcl.clozure.com")
Note: See TracChangeset for help on using the changeset viewer.