minor revisions of examples
[eql:eql.git] / examples / M-modules / webkit / Examples-Browser / examples-browser.lisp
1 ;;; "Examples" Browser
2 ;;;
3 ;;; (depends on small plugin, see "lib/examples_browser.pro")
4 ;;;
5 ;;; Run EQL examples "downloading"/starting them from an EQL WebKit browser.
6 ;;;
7 ;;; Here we use the local example files, but you could put them on a server and point
8 ;;; the QUrl to a network location (in function RUN, see below).
9 ;;;
10 ;;; Once downloaded, the application files are cached locally (to be run offline).
11
12 (qrequire :webkit)
13 (qrequire :network)
14
15 (in-package :eql-user)
16
17 (load "../inspector")
18
19 (defvar *web-view*        (qnew "QWebView" "windowTitle" "EQL WebKit"))
20 (defvar *network-manager* (qnew "QNetworkAccessManager"))
21 (defvar *webkit-bridge*   (qload-c++ "lib/examples_browser"))
22 (defvar *files-left*)
23 (defvar *ini-file*)
24
25 (defun frame ()
26   (! ("mainFrame" "page" *web-view*)))
27
28 (defun ini ()
29   (qconnect (frame) "javaScriptWindowObjectCleared()"
30             (lambda ()
31               (! "addToJavaScriptWindowObject" (frame) "Lisp" *webkit-bridge*)))
32   (qconnect *network-manager* "finished(QNetworkReply*)" 'download-finished)
33   (! "setUrl" *web-view* (qnew "QUrl(QString)" "examples-browser.htm"))
34   (! "showMaximized" *web-view*))
35
36 ;;; download
37
38 (defun download (url id name)
39   (qlet ((qurl "QUrl(QString)" url)
40          (request "QNetworkRequest(QUrl)" qurl)
41          (qid "QVariant(QString)" id)
42          (qname "QVariant(QString)" name))
43     (let ((reply (! "get" *network-manager* request)))
44       ;; dynamic properties
45       (! "setProperty" reply "id" qid)
46       (! "setProperty" reply "cache-name" qname))))
47
48 (defun download-finished (reply)
49   (! "deleteLater" reply) ; QNetworkReply*: heap result, delete manually
50   (let ((error (! "error" reply)))
51     (if (= |QNetworkReply.NoError| error)
52         (save-data reply)
53         (show-download-error error))))
54
55 (defun cache-file (name)
56   (format nil "cache/~A" name))
57
58 (defun save-data (reply)
59   (let ((file (cache-file (! ("toString" ("property" "cache-name") reply))))) ; dynamic property
60     (ensure-directories-exist file)
61     (with-open-file (s file :direction :output :if-exists :supersede
62                        :element-type '(signed-byte 8))
63       (write-sequence (! "readAll" reply) s)))
64   (when (zerop (decf *files-left*))
65     (load* (! ("toString" ("property" "id") reply)) ; dynamic property
66            *ini-file*)))
67
68 (let (top-level-widgets)
69   (defun load* (id file)
70     (load file)
71     (let ((latest (first (sort (! "topLevelWidgets" "QApplication") '> :key 'qt-object-unique))))
72       (push (cons id latest)
73             top-level-widgets)
74       (x:do-with latest "show" "raise")))
75   (defun load/show (id file)
76     (let ((widget (cdr (find id top-level-widgets :test 'string= :key 'car))))
77       (if widget
78           (progn
79             (! (if (qget widget "minimized") "showNormal" "show") widget)
80             (! "raise" widget))
81           (load* id file)))))
82
83 (defun show-download-error (error)
84   (let ((msg (x:when-it (find error (cdadr (qenums "QNetworkReply" "NetworkError")) :key 'cdr)
85                (format nil (tr "Download error: <span style='color:red; font-weight:bold;'>~A</span>")
86                        (car x:it)))))
87     (! "critical" "QMessageBox" nil "EQL" (or msg (tr "Unknown download error.")))))
88
89 ;;; these functions are callable from JavaScript (see "lib/examples_browser.*")
90
91 (defun run (id file-names)
92   (let ((ini-file (cache-file (first file-names))))
93     (if (probe-file ini-file)
94         (load/show id ini-file)
95         (progn
96           (setf *files-left* (length file-names)
97                 *ini-file*   ini-file)
98           ;; QNetworkAccessManager does it all for us (asynchroneous, parallel download)
99           (dolist (name file-names)
100             (download (format nil "file:///~A" (in-home "examples/" name)) ; change this to a network location
101                       id
102                       name))))))
103
104 (defun clear-cache ()
105   (let ((fs 0)
106         (ds 0))
107     ;; delete files
108     (dolist (file (directory "cache/**/*.*"))
109       (when (ignore-errors (delete-file file))
110         (incf fs)))
111     ;; delete empty directories
112     (dolist (dir (butlast (sort (directory "cache/**/") '>
113                                 :key (lambda (dir) (count #\/ (namestring dir))))))
114       (when (ignore-errors (delete-file dir))
115         (incf ds)))
116     (! "setPlainText" (! "findFirstElement" (frame) "#message")
117        (format nil "deleted: ~D file~:P, ~D director~:@P" fs ds))))
118
119 (ini)