mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 10:40:45 -08:00
Code Issues Projects Releases Wiki Activity

Some refactoring

Browse source
This commit is contained in:
David Botton 2022-01-24 22:06:00 -05:00
parent f93d79acd8
commit 21f6e6abfd
1 changed files with 22 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

39
tools/clog-builder.lisp
View file

@ -72,6 +72,18 @@
"Remove a control identified by HTML-ID from control-list on PANEL-ID" "Remove a control identified by HTML-ID from control-list on PANEL-ID"
(remhash html-id (get-control-list app panel-id))) (remhash html-id (get-control-list app panel-id)))
;; Handle per content next-id counts
(defun next-id (content)
(parse-integer (attribute content "data-clog-next-id") :junk-allowed t))
(defun setf-next-id (content id)
(setf (attribute content "data-clog-next-id") (format nil "~A" id)))
(defun incf-next-id (content)
(setf-next-id content (1+ (next-id content))))
;; Local file utilities ;; Local file utilities
(defun read-file (infile) (defun read-file (infile)
@ -89,6 +101,8 @@
(with-open-file (outstream outfile :direction :output :if-exists action-if-exists) (with-open-file (outstream outfile :direction :output :if-exists action-if-exists)
(write-sequence string outstream))) (write-sequence string outstream)))
;; Lisp code evaluation utilities
(defun capture-eval (form &key (eval-in-package :clog-user)) (defun capture-eval (form &key (eval-in-package :clog-user))
"Capture lisp evaluaton of FORM" "Capture lisp evaluaton of FORM"
(let ((result (make-array '(0) :element-type 'base-char (let ((result (make-array '(0) :element-type 'base-char
@ -247,6 +261,12 @@ access to it and allows manipulation of location, size etc of the control."
(set-border (get-placer (current-control app)) (unit "px" 0) :none :blue) (set-border (get-placer (current-control app)) (unit "px" 0) :none :blue)
(setf (current-control app) nil))) (setf (current-control app) nil)))
(defun delete-current-control (app panel-id html-id)
(remove-from-control-list app panel-id html-id)
(destroy (get-placer (current-control app)))
(destroy (current-control app))
(setf (current-control app) nil))
(defun select-control (control) (defun select-control (control)
"Select CONTROL as the current control and highlight its placer. "Select CONTROL as the current control and highlight its placer.
The actual original clog object used for creation must be used and The actual original clog object used for creation must be used and
@ -645,15 +665,6 @@ of controls and double click to select control."
(defparameter *builder-template2* (defparameter *builder-template2*
"~% (~A (attach-as-child body \"~A\" :clog-type '~A))") "~% (~A (attach-as-child body \"~A\" :clog-type '~A))")
(defun next-id (content)
(parse-integer (attribute content "data-clog-next-id") :junk-allowed t))
(defun setf-next-id (content id)
(setf (attribute content "data-clog-next-id") (format nil "~A" id)))
(defun incf-next-id (content)
(setf-next-id content (1+ (next-id content))))
(defun on-new-builder-panel (obj) (defun on-new-builder-panel (obj)
"Open new panel" "Open new panel"
(let* ((app (connection-data-item obj "builder-app-data")) (let* ((app (connection-data-item obj "builder-app-data"))
@ -700,10 +711,7 @@ of controls and double click to select control."
(set-on-click btn-del (lambda (obj) (set-on-click btn-del (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)
(remove-from-control-list app panel-id (html-id (current-control app))) (delete-current-control app panel-id (html-id (current-control app)))
(destroy (get-placer (current-control app)))
(destroy (current-control app))
(setf (current-control app) nil)
(on-populate-control-properties-win win) (on-populate-control-properties-win win)
(on-populate-control-list-win content)))) (on-populate-control-list-win content))))
(set-on-click btn-sim (lambda (obj) (set-on-click btn-sim (lambda (obj)
@ -888,10 +896,7 @@ of controls and double click to select control."
(set-on-click btn-del (lambda (obj) (set-on-click btn-del (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (current-control app) (when (current-control app)
(remove-from-control-list app panel-id (html-id (current-control app))) (delete-current-control app panel-id (html-id (current-control app)))
(destroy (get-placer (current-control app)))
(destroy (current-control app))
(setf (current-control app) nil)
(on-populate-control-properties-win content) (on-populate-control-properties-win content)
(on-populate-control-list-win content)))) (on-populate-control-list-win content))))
(set-on-click btn-sim (lambda (obj) (set-on-click btn-sim (lambda (obj)