demo.lisp

   1 ;;; demo.lisp - usage examples
   2 ;; Copyright (C) 2011, Joachim Fasting
   3 ;;
   4 ;;   This file is part of cl-webkit
   5 ;;
   6 ;; All rights reserved.
   7 ;;
   8 ;; Redistribution and use in source and binary forms, with or without
   9 ;; modification, are permitted provided that the following conditions are met:
  10 ;;
  11 ;; 1. Redistribution of source code must retain the above copyright
  12 ;;    notice, this list of conditions and the following disclaimer.
  13 ;;
  14 ;; 2. Redistribution in binary form must reproduce the above copyright
  15 ;;    notice, this list of conditions and the following disclaimer in the
  16 ;;    documentation and/or other materials provided with the distribution.
  17 ;;
  18 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
  19 ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  20 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  21 ;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
  22 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  23 ;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  24 ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  25 ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  26 ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  27 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28
  29 \f
  30 ;;; Code:
  31
  32 (in-package :cl-user)
  33
  34 (defpackage :cl-webkit-demo
  35   (:use :cl)
  36   (:nicknames "webkit-demo")
  37   (:export #:simple-browser))
  38
  39 (in-package :cl-webkit-demo)
  40
  41 (defun simple-browser ()
  42   "A single-window browser with no keyboard or mouse input.
  43 Loads and renders a single web page."
  44   (gtk:within-main-loop
  45     (let ((win (make-instance 'gtk:gtk-window))
  46           (scrolled (make-instance 'gtk:scrolled-window))
  47           (view (webkit.foreign:webkit-web-view-new)))
  48       (gtk:container-add scrolled view)
  49       (gtk:container-add win scrolled)
  50       (webkit.foreign:webkit-web-view-load-uri view "http://www.example.com")
  51       (gtk:widget-show win))))