mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-10 04:40:13 -08:00
Added error handling
This commit is contained in:
parent
94fc1d69c5
commit
4c533e8cbc
2 changed files with 21 additions and 11 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue