From e29308e55a6c4d489a84be993a38eb63e529231d Mon Sep 17 00:00:00 2001
From: David Botton <david@botton.com>
Date: Sun, 26 May 2024 14:21:34 -0400
Subject: [PATCH] icon area added

---
 source/clog-gui.lisp          | 27 ++++++++++++++++++++++-----
 tools/clog-builder-files.lisp | 21 +++++++++++++++++++++
 tools/clog-builder.lisp       |  1 -
 3 files changed, 43 insertions(+), 6 deletions(-)

diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp
index 8a9e69b..85027d0 100644
--- a/source/clog-gui.lisp
+++ b/source/clog-gui.lisp
@@ -52,6 +52,7 @@
   (clog-gui-window             class)
   (create-gui-window           generic-function)
   (window-title                generic-function)
+  (window-icon-area            generic-function)
   (window-param                generic-function)
   (window-content              generic-function)
   (window-focus                generic-function)
@@ -524,6 +525,17 @@ window or nil if not found"))
              (windows app))
     r))
 
+;;;;;;;;;;;;;;;;;;;;;;
+;; window-icon-area ;;
+;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-icon-area (clog-obj)
+  (:documentation "Return the clog-obj for the icon-area to allow adding
+custom icons on the title bar to the right of the close icon"))
+
+(defmethod window-icon-area ((obj clog-obj))
+  (icon-area obj))
+
 ;;;;;;;;;;;;;;;;;;;;;
 ;; window-by-param ;;
 ;;;;;;;;;;;;;;;;;;;;;
@@ -857,6 +869,9 @@ The on-window-change clog-obj received is the new window"))
     :accessor pinner
     :initform nil
     :documentation "Window pinner clog-element if created with has-pinner")
+   (icon-area
+     :accessor icon-area
+     :documentation "Window icon area for adding icons to menu bar")
    (closer
     :accessor closer
     :documentation "Window closer clog-element")
@@ -1112,7 +1127,9 @@ window-to-top-by-param or window-by-param."))
                        style='position:absolute;top:0;right:0;left:0;height:25px'>
                     <span data-drag-obj='~A' data-drag-type='m' id='~A-title'
                       style='position:absolute;top:0;right:20px;left:5px;
-                             user-select:none;cursor:move;'>~A</span>~A
+                             user-select:none;cursor:move;'>~A</span>
+                    <span id='~a-icons' style='position:absolute;top:0;right:15px;
+                        cursor:pointer;user-select:none;'>~A</span>
                     <span id='~A-closer'
                       style='position:absolute;top:0;right:5px;cursor:pointer;user-select:none;'>~A</span>
                   </div>
@@ -1125,11 +1142,10 @@ window-to-top-by-param or window-by-param."))
             border-class
             html-id title-class html-id html-id         ; title bar
             title                                       ; title
+            html-id                                     ; icons area
             (if has-pinner                              ; pinner
-                (format nil "<span id='~A-pinner'
-                 style='position:absolute;top:0;right:20px;
-                        cursor:pointer;user-select:none;'>
-                 ~A</span><span>&nbsp;&nbsp;&nbsp;</span>" html-id (code-char 9744))
+                (format nil "<span id='~A-pinner'>~A</span>&nbsp;"
+                        html-id (code-char 9744))
                 "")
             html-id                                     ; closer
             closer-html
@@ -1155,6 +1171,7 @@ window-to-top-by-param or window-by-param."))
       (when has-pinner
         (setf (pinner win) (attach-as-child win (format nil "~A-pinner" html-id))))
       (setf (closer win) (attach-as-child win (format nil "~A-closer" html-id)))
+      (setf (icon-area win) (attach-as-child win (format nil "~A-icons" html-id)))
       (unless no-sizer
         (setf (sizer win) (attach-as-child win (format nil "~A-sizer" html-id))))
       (setf (content win) (attach-as-child win (format nil "~A-body"  html-id)))
diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp
index e810360..6d69264 100644
--- a/tools/clog-builder-files.lisp
+++ b/tools/clog-builder-files.lisp
@@ -166,6 +166,27 @@
         (declare (ignore spacer1 spacer2))
         (setf (window-param win) ace)
         (add-class menu "w3-small")
+        (set-on-click (create-span (window-icon-area win)
+                                   :content (format nil "~A&nbsp;" (code-char #x26F6))
+                                   :auto-place :top)
+                      (lambda (obj)
+                        (declare (ignore obj))
+                        (set-geometry win
+                                      :top (menu-bar-height win)
+                                      :left 300
+                                      :height "" :width ""
+                                      :bottom 5 :right 0)
+                        (clog-ace:resize (window-param win))
+                        (set-on-window-move win nil)
+                        (set-on-window-move win (lambda (obj)
+                                                  (setf (width obj) (width obj))
+                                                  (setf (height obj) (height obj))))))
+        (set-on-click (create-span (window-icon-area win)
+                                   :content "-&nbsp;"
+                                   :auto-place :top)
+                      (lambda (obj)
+                        (declare (ignore obj))
+                        (setf (hiddenp win) t)))
         (setf (overflow (top-panel box)) :visible) ; let menus leave the top panel
         (setf (z-index m-file) 10) ; fix for ace editor gutter overlapping menu
         (when has-time-out
diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp
index a00fb96..d1e5cb0 100644
--- a/tools/clog-builder.lisp
+++ b/tools/clog-builder.lisp
@@ -16,7 +16,6 @@ clog-builder window.")
 (defparameter *clogframe-mode* nil
               "If *clogframe-mode* is t no popup or tabs possible.")
 (defparameter *preferances-file* nil "Location of the preferance file")
-
 (defparameter *start-project* nil "Set the project to start with")
 (defparameter *start-dir* nil "Set the directory the dir win should start with")
 (defparameter *client-side-movement* nil "Use javascript for window movement")