Added error handling

This commit is contained in:
David Botton 2021-03-11 10:34:30 -05:00
parent 94fc1d69c5
commit 4c533e8cbc
2 changed files with 21 additions and 11 deletions

View file

@ -1227,8 +1227,10 @@ interactions. Use window-end-modal to undo."))
(defun alert-toast (obj title content &key (defun alert-toast (obj title content &key
(color-class "w3-red") (color-class "w3-red")
(time-out nil) (time-out nil)
(place-top nil)
(html-id nil)) (html-id nil))
"Create an alert toast with option :TIME-OUT" "Create an alert toast with option :TIME-OUT. If place-top is t then alert
is placed in DOM at top of html body instead of bottom of html body."
(unless html-id (unless html-id
(setf html-id (clog-connection:generate-id))) (setf html-id (clog-connection:generate-id)))
(let* ((body (connection-data-item obj "clog-body")) (let* ((body (connection-data-item obj "clog-body"))
@ -1242,8 +1244,12 @@ interactions. Use window-end-modal to undo."))
color-class color-class
html-id html-id
title title
content))) content)
:auto-place nil))
(closer (attach-as-child body (format nil "~A-close" html-id)))) (closer (attach-as-child body (format nil "~A-close" html-id))))
(if place-top
(place-inside-top-of body win)
(place-inside-bottom-of body win))
(set-on-click closer (lambda (obj) (set-on-click closer (lambda (obj)
(destroy win))) (destroy win)))
(when time-out (when time-out

View file

@ -19,7 +19,7 @@
;;;; --------------------------------------------------------- ;;;; ---------------------------------------------------------
(defpackage #:clog-user (defpackage #:clog-user
(:use #:cl #:clog #:clog-web) (:use #:cl #:clog #:clog-web #:clog-gui)
(:export start-tutorial)) (:export start-tutorial))
(in-package :clog-user) (in-package :clog-user)
@ -40,6 +40,8 @@
(set-on-submit form (set-on-submit form
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(handler-case
(progn
(setf (inner-html results-section) (setf (inner-html results-section)
(format nil "~A<br>~A" (format nil "~A<br>~A"
(inner-html results-section) (inner-html results-section)
@ -47,7 +49,9 @@
(value command) (value command)
:force-shell t :output :string)))) :force-shell t :output :string))))
(setf (scroll-top results-section) (setf (scroll-top results-section)
(scroll-height results-section)) (scroll-height results-section)))
(error (c)
(alert-toast body "Error" c :time-out 2 :place-top t)))
(setf (value command) "")))) (setf (value command) ""))))
(setf (overflow results-section) :scroll) (setf (overflow results-section) :scroll)
(set-border results-section :thin :solid :black) (set-border results-section :thin :solid :black)