source: trunk/source/examples/webkit.lisp @ 9793

Last change on this file since 9793 was 6232, checked in by gb, 13 years ago

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

Use OBJC:LOAD-FRAMEWORK.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.0 KB
Line 
1
2;;;-*-Mode: LISP; Package: CCL -*-
3
4(in-package "CCL")
5
6(eval-when (:compile-toplevel :load-toplevel :execute)
7  (require "COCOA"))
8
9(eval-when (:compile-toplevel :load-toplevel :execute)
10  (objc:load-framework "WebKit" :webkit))
11
12
13(defun pathname-to-file-url (pathname)
14  ;; NATIVE-TRANSLATED-NAMESTRING returns a simple string that can be
15  ;; passed to a filesystem function.  (It may be exactly the same as
16  ;; what NAMESTRING returns, or it may differ if special characters
17  ;; were escaped in NAMESTRING's result.)
18  (with-autorelease-pool
19    (#/retain
20     (#/fileURLWithPath: ns:ns-url (%make-nsstring
21                                    (native-translated-namestring pathname))))))
22
23(defun url-from-string (s)
24  (with-autorelease-pool
25    (#/retain (#/URLWithString: ns:ns-url (%make-nsstring (string s))))))
26                 
27
28(defun browser-window (urlspec)
29  ;; Content rect for window, bounds rect for view.
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)))))
72       
73;;; (browser-window "http://openmcl.clozure.com")
Note: See TracBrowser for help on using the repository browser.