source: branches/objc-gf/ccl/examples/webkit.lisp @ 6130

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

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.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.8 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  (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.")))
33
34(eval-when (:compile-toplevel :load-toplevel :execute)
35  (require-webkit))
36
37(defun pathname-to-file-url (pathname)
38  ;; NATIVE-TRANSLATED-NAMESTRING returns a simple string that can be
39  ;; passed to a filesystem function.  (It may be exactly the same as
40  ;; what NAMESTRING returns, or it may differ if special characters
41  ;; were escaped in NAMESTRING's result.)
42  (with-autorelease-pool
43   (send       
44    (send (@class "NSURL")
45          :file-url-with-path (%make-nsstring
46                               (native-translated-namestring pathname)))
47    'retain)))
48
49(defun url-from-string (s)
50  (with-autorelease-pool
51   (send 
52    (send (@class "NSURL") "URLWithString:" (%make-nsstring (string s)))
53    'retain)))
54                 
55
56(defun browser-window (urlspec)
57  ;; 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-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-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)))))
106       
107;;; (browser-window "http://openmcl.clozure.com")
Note: See TracBrowser for help on using the repository browser.