Paste number 320742: house-of-saud

Index of paste annotations: 1

Paste number 320742: house-of-saud
Pasted by: gabriel_laddel
When:6 years, 4 months ago
Share:Tweet this! | http://paste.lisp.org/+6VHI
Channel:None
Paste contents:
Raw Source | XML | Display As
;;; MMG::GUI-BUILDER, vanilla
;;; ============================================================================
;;; I did my best to remove all masamune'isms from this, dunno if it will 
;;; compile, but meh. 
;;;
;;; requires anaphoric macros, aif to be pulled in.. also you must be running
;;; stumpwm. cl-ppcre too...
;;;
;;; TODO
;;; ----------------------------------------
;;; - transpose panes, swap panes (select one, select another)
;;; - edge cases: setting focus
;;; - detailed, specialized pointer documentation
;;;
;;; NOTES
;;; ----------------------------------------
;;; spacing-panes have children, while applications panes can be used to simply
;;; offset something if necessary
;;;
;;; I don't know how to read in commands without an interactor, and as such 
;;; render output records to unspecialized-panes

(in-package climi)

(defmacro with-centers (sheet &rest body)
  "introduces the bindings `center-x', `center-y'"
  `(destructuring-bind (x0 y0 x1 y1)
       (LOOP FOR I ACROSS (SLOT-VALUE (SLOT-VALUE ,sheet 'REGION) 'CLIM-INTERNALS::COORDINATES)
	     COLLECT I)
     (let* ((center-x (/ (- x1 x0) 2))
	    (center-y (/ (- y1 y0) 2)))
       ,@body)))

(defparameter gui-sexpr nil)

(defparameter user-visible-pane-types
  '(tab-layout
    list-pane
    interaction-pane ;; / interactor
    check-box-pane
    label-pane
    option-pane
    table-pane
    title-pane
    text-editor-pane
    text-field-pane
    table-pane
    slider-pane)
  "This should be computed as 'all subclasses of pane that have a corresponding
 view' or the like")

(defvar extant-guis
  '(DASHBOARD
    GLOBAL-HELP
    BUILDER
    KMAP
    REPOSITORY
    TEST-APP))

(let* ((x-padding 100)
       (y-padding 50)
       (text-field-width 320))
  (gui gui-builder () ()
    ((current-pane :initarg nil :accessor current-pane))
    (:pointer-documentation t)
    (:menu-bar nil)
    (:panes (esa-toggle :toggle-button
                        :label "Emacs Style Application?"
                        :value t)
            
            (pointer-doc-toggle :toggle-button
                                :label "Does it have pointer documentation?"
                                :value t)
            
            (menu-bar-toggle :toggle-button
                             :label "A menu bar?"
                             :value t)
            
            (EXTANT-GUI-LIST :list-pane
                             :items extant-guis
                             :min-width 100
                             :min-height 50
                             :max-height 100)
            
            (MODIFY-GUI-BUTTON :push-button
                               :label "Modify")
            (CLONE-GUI-BUTTON :push-button 
                              :label "or Clone")
            (NEW-GUI-TEXT-FIELD :text-field
                                :value "Name of new GUI"
                                :value-changed-callback 'mm::nope
                                :width text-field-width
                                :max-width text-field-width
                                :min-width text-field-width
                                :height 40
                                :max-height 40
                                :min-height 40)
            
            (NEW-GUI-BUTTON :push-button
                            :label "Create"
                            :activate-callback 'create-new-gui)
            
            (left-spacing :application
                          :scroll-bars nil
                          :min-width x-padding
                          :max-width x-padding
                          :border-width 0)

            (right-spacing :application
                           :scroll-bars nil
                           :min-width x-padding
                           :max-width x-padding
                           :border-width 0)
            
            (top-spacing :application
                         :scroll-bars nil
                         :min-width y-padding
                         :max-width y-padding
                         :border-width 0)

            (bottom-spacing :application
                            :scroll-bars nil
                            :min-width y-padding
                            :max-width y-padding
                            :border-width 0)
            
            (or-label :label 
                      :label "OR"
                      :align-x :center
                      :align-y :center
                      :text-style (make-text-style :sans-serif :bold 40))
            
            ;; Live modification
            ;; ------------------------------------
            (user-visible-panes :list-pane
                                :items user-visible-pane-types)
            (live-modification-root :application
                                    :scroll-bars nil
                                    :display-function 'render-live-modification-pane))
    (:layouts (:gui-derivation (horizontally ()
                                 (1/5 (vertically ()
                                        (300 (labelling (:label "DERIVE A GUI"
                                                                :align-x :center
                                                                :text-style (make-text-style :sans-serif :bold 30))
                                               (vertically ()
                                                 (labelling (:label "Is this GUI an,")
                                                   (horizontally ()
                                                     (270 esa-toggle)
                                                     (300 pointer-doc-toggle)
                                                     (200 menu-bar-toggle)))
                                                 20
                                                 (horizontally ()
                                                   (1/3 (labelling (:label "An existing GUI"
                                                                           :label-alignment :bottom
                                                                           :align-x :center)
                                                          (vertically ()
                                                            (scrolling (:type :vertical)
                                                              extant-gui-list)                                                     
                                                            (22 (horizontally ()
                                                                    (155 modify-gui-button)
                                                                    (155 clone-gui-button))))))
                                                   (100 or-label)
                                                   (1/3 (labelling (:label "A new GUI"
                                                                           :label-alignment :bottom
                                                                           :align-x :center)
                                                          (vertically () 
                                                            new-gui-text-field
                                                            new-gui-button)))))))))))
              (:live-modification (vertically ()
                                    live-modification-root)))))  

(defun create-new-gui (this)
  (declare (ignore this))
  (let* ((menu-bar? (find-pane-named *application-frame* 'menu-bar-toggle))
         (esa-gui? (find-pane-named *application-frame* 'esa-toggle))
         (pointer-documentation? (find-pane-named *application-frame* 'pointer-doc-toggle))
         (gui-name (string-upcase (gadget-value (find-pane-named *application-frame* 'new-gui-text-field)))))
    (if (scan #\space gui-name)         
        (stumpwm::message "spaces are allowed in the name of the GUI!")
        (progn (setf gui-sexpr
                     `(gui ,(intern gui-name 'mmg) nil :esa-gui? ,esa-gui?
                        (:menu-bar ,menu-bar?)
                        (:pointer-documentation ,pointer-documentation?)))               
               (SETF (frame-current-layout (GUI-BUILDER-FRAME)) :LIVE-MODIFICATION)))))

(defun modify-scrollbar (radio-box-pane selected-gadget)
  (let* ((scroller-type (read-from-string (gadget-label selected-gadget)))
         (scroller-type (ecase scroller-type
                          (nil nil)
                          (:vertical scroller-type)
                          (:horizontal scroller-type)
                          (:both t))))
    (if scroller-type
        (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
          (let* ((unspecialized-pane (sheet-parent (sheet-parent radio-box-pane)))
                 (parent (sheet-parent unspecialized-pane)))
            (sheet-disown-child parent unspecialized-pane)
            (let* ((viewport (make-pane 'clim-extensions::viewport-pane
                                        :contents (list unspecialized-pane)))
                   (scrollbar-pane (make-pane 'scroller-pane
                                              :contents (list viewport)
                                              :scroll-bar scroller-type)))
              (sheet-adopt-child parent scrollbar-pane)
              (redisplay-frame-panes *application-frame*))))
        (message "nope.jpg"))))

(defun rack-parent (pane)
  "Returns the parent and its disownable child as VALUES"
  ;; see MAKE-THIS-A-TAB-PANE, this returns the wrong thing
  (loop with parents-disownable-child = pane
        with parent = (sheet-parent parents-disownable-child)
        while (not (or (eq 'clim:vrack-pane (type-of parent))
                       (eq 'clim:hrack-pane (type-of parent))))
        do (setf parent-disownable-child parent
                 parent (sheet-parent parent))
        finally (return (values parent parents-disownable-child))))

(defun make-this-a-tab-pane (this-gadget)
  (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
    (let* ((first-tab-child (sheet-parent this-gadget)) ;; should be live modification root
           (second-tab-child 
            (make-pane 'application-pane 
                       :display-function (lambda (frame pane)
                                           (declare (ignore frame))
                                           (with-centers pane
                                             (draw-text* pane "I live to serve" center-x center-y 
                                                         :text-size 30))))))
      (multiple-value-bind (parent disownable-child)
          (rack-parent first-tab-child)
        ;; vrack-pane
        ;; ahaha, so the thing is that vrack pane does not have children, it has a list of contents
        (sheet-disown-child parent (sheet-parent disownable-child))
        ;; the name of this tab-layout-pane needs to be auto-generated so we can find-frame it 
        (sheet-adopt-child parent (with-tab-layout ('tab-page :name 'gui-builder-layout) 
                                    ("First Tab" (sheet-parent first-tab-child))
                                    ("Second Tab" second-tab-child)))
        (redisplay-frame-panes *application-frame*)))))

(defun sheet-child-containing (parent-sheet child-sheet)
  "Returns NIL if the child is not found in the parent's decendents"
  (loop for last-seen-child = child-sheet then (sheet-parent last-seen-child)
        while (not (climi::top-level-sheet-pane-p last-seen-child))
        do (when (eq parent-sheet (sheet-parent last-seen-child))
             (return-from sheet-child-containing last-seen-child))))

(defun sheet-disown-child-containing (parent-sheet child-sheet)
  "When one wishes to disown a sheet from its parent and traverses the sheet 
heigharcy using SHEET-PARENT he will sometimes find that his sheet is distanced
from the VRACK-PANE (or whatever) by border-panes, viewports, scrollbars etc.

SHEET-DISOWN-CHILD-CONTAINING searches from the parent in question down to the 
child sheet and then disowns the tree containing it, returning the tree in 
question

Tastes great with RACK-PARENT, which can be used to locate the parent one wants
to disown from"
  (awhen (sheet-child-containing parent-sheet child-sheet)
    (sheet-disown-child parent-sheet it)
    it))

(defun new-unspecialized-pane ()
  (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
    (make-pane 'application-pane 
               :display-function (lambda (frame pane)
                                   (declare (ignore frame))
                                   (with-centers pane
                                     (draw-text* pane "I live to serve" center-x center-y 
                                                 :text-size 20))))))

(macrolet 
  ;; TODO, @2016-07-15T12:43:29.061876Z
  ;; - does not split the pane inside the tab if we're in a tab layout.
  ;;   should detect and add a surrounding v/hbox-pane
  ((m (name pane-type)
      `(defun ,(format-symbol t "SPLIT-~A" name) (this-gadget)
         (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
           (let* ((unspecialized-pane (sheet-parent this-gadget))
                  (parent (rack-parent unspecialized-pane))
                  (unspecialized-pane-container 
                   (sheet-disown-child-containing parent unspecialized-pane)) ;; returns the border pane we stick in the vrack
                  (new-rack-pane (make-pane ',pane-type
                                            :contents (list unspecialized-pane-container
                                                            (new-unspecialized-pane)))))
             (sheet-adopt-child parent new-rack-pane)
             (redisplay-frame-panes *application-frame*))))))
  (m vertically vrack-pane)
  (m horizontally hrack-pane))

(define-gui-builder-command (com-add-unspecialized-tab-page)
                            ((tab-page 'tab-page :gesture :delete))
                            (let* ((tab-layout-pane (clim-tab-layout::tab-page-tab-layout tab-page))
                                   (new-tab-page (clim-tab-layout::make-tab-page (symbol-name (gensym))
                                                                                 (new-unspecialized-pane))))
                              (add-page new-tab-page tab-layout-pane t)))

(defun remove-this-pane (this-gadget)
  (stumpwm::message "implement me!"))

(defun render-live-modification-pane (frame pane)
  ;; Then proceeds to specialize mmg::unspecialized-pane
  ;; - tabpane, further split? specialize against any
  ;;   other pane or gadget type?
  ;; - w/h, min max on each
  ;; - create, reuse existing render routine
  ;; - scrollbars
  ;; - modify whatever defmethod calls `display-function' so that we can
  ;;   print errors to the pane (or bubble them up) according to
  ;;   'store-conditions-to-pane?'
  ;; - add draggable box one or more sides.
  ;;
  ;; or we could allocate some space?
  (setf (stream-cursor-position pane)
        (values 300 300)
        (stream-cursor-position pane)
        (values 10 10))
  (with-look-and-feel-realization ((find-frame-manager) frame)
     (let* ((stream pane)
            (scroll-bars-radio (labelling (:label "scroll bars"
                                                  :align-x :center)
                                (with-radio-box (:orientation :horizontal
                                                              :parent stream
                                                              :value-changed-callback 'modify-scrollbar)
                                 ":BOTH"
                                 ":VERTICAL"
                                 ":HORIZONTAL"
                                  (climi::radio-box-current-selection "NIL"))))
            (render-routine-button
             (make-pane 'push-button
                        :label "Create / Modify a Rendering Routine"
                        :activate-callback (lambda (_) (clim-demo::clim-fig))
                        :parent stream))
            
            (make-it-a-tab-pane-button
             (make-pane 'push-button
              :label "Make it a Tab Pane"
              :activate-callback 'make-this-a-tab-pane))
            
            (hsplit-button
             (make-pane 'push-button
              :label "Split Horizontally"
              :activate-callback 'split-horizontally))
            
            (vsplit-button
             (make-pane 'push-button
              :label "Split Vertically"
              :activate-callback 'split-vertically))
            
            (remove-button
             (make-pane 'push-button
              :label "Remove Pane"
              :activate-callback 'remove-this-pane)))
      (dolist (gadget (list scroll-bars-radio
                            render-routine-button
                            make-it-a-tab-pane-button
                            hsplit-button
                            vsplit-button
                            remove-button))
        (with-output-as-gadget (stream) gadget)
        ;; can call SHEET-REGION on the output, and use the height to calculate
        ;; exactly how far to y step
        (with-cursor-position stream
          (setf (stream-cursor-position stream) (values 10 cy)))))))

;;; Rendering routine nonsense
;;; ============================================================================

; (ed #P(:p ("McCLIM" "Examples") "clim-fig.lisp"))

;; this relies on the `push'ing each drawn thing from CLIM-DEMO::CLIM-FIG onto
;; CLIM-DEMO::DRAWING-SEXPRS
#+nil(defun generate-display-function-sexpr (frame pane)
  (let* ((sexpr-skeleton clim-demo::drawing-sexprs)
         (generated-code-path #P"/tmp/gui-builder-genertaed-functions.lisp") 
         (display-function-name))
    (with-open-file (s generated-code-path 
                     :if-exists :append
                     :if-does-not-exist :create)
      (format s "~&~S~%"
              (append (list 'defun display-function-name '(frame pane))
                      sexpr-skeleton)))
    (compile-file generated-code-path)
    (setf clim-demo::drawing-sexprs nil
          (climi::pane-display-function pane) display-function-name)))

Annotations for this paste:

Annotation number 1: vanilla-muffins
Pasted by: muffinfish
When:6 years, 4 months ago
Share:Tweet this! | http://paste.lisp.org/+6VHI/1
Paste contents:
Raw Source | Display As
;;; MMG::GUI-BUILDER, vanilla
;;; ============================================================================
;;; I did my best to remove all masamune'isms from this, dunno if it will 
;;; compile, but meh. 
;;;
;;; requires anaphoric macros, aif to be pulled in.. also you must be running
;;; stumpwm. cl-ppcre too...
;;;
;;; TODO
;;; ----------------------------------------
;;; - transpose panes, swap panes (select one, select another)
;;; - edge cases: setting focus
;;; - detailed, specialized pointer documentation
;;;
;;; NOTES
;;; ----------------------------------------
;;; spacing-panes have children, while applications panes can be used to simply
;;; offset something if necessary
;;;
;;; I don't know how to read in commands without an interactor, and as such 
;;; render output records to unspecialized-panes

(in-package climi)

(use-package 'cl-ppcre)
(use-package 'clim-tab-layout)

(defmacro with-cursor-position (stream &rest body)
  "Introduces the symbol-capturing variables MMG::CX & MMG::CY"
  `(multiple-value-bind (cx cy) (stream-cursor-position ,stream)
     ,@body))

(defmacro with-centers (sheet &rest body)
  "introduces the bindings `center-x', `center-y'"
  `(destructuring-bind (x0 y0 x1 y1)
       (LOOP FOR I ACROSS (SLOT-VALUE (SLOT-VALUE ,sheet 'REGION) 'CLIM-INTERNALS::COORDINATES)
	     COLLECT I)
     (let* ((center-x (/ (- x1 x0) 2))
	    (center-y (/ (- y1 y0) 2)))
       ,@body)))

(defparameter gui-sexpr nil)

(defparameter user-visible-pane-types
  '(tab-layout
    list-pane
    interaction-pane ;; / interactor
    check-box-pane
    label-pane
    option-pane
    table-pane
    title-pane
    text-editor-pane
    text-field-pane
    table-pane
    slider-pane)
  "This should be computed as 'all subclasses of pane that have a corresponding
 view' or the like")

(defvar extant-guis
  '(DASHBOARD
    GLOBAL-HELP
    BUILDER
    KMAP
    REPOSITORY
    TEST-APP))

;; macroexpansion of MMG::GUI
(let* ((x-padding 100)
       (y-padding 50)
       (text-field-width 320))
 (DEFINE-APPLICATION-FRAME GUI-BUILDER NIL
   ((CURRENT-PANE :INITARG NIL :ACCESSOR CURRENT-PANE))
   (:POINTER-DOCUMENTATION T)
   (:MENU-BAR NIL)
   (:PANES (ESA-TOGGLE :TOGGLE-BUTTON :LABEL "Emacs Style Application?" :VALUE T)
           (POINTER-DOC-TOGGLE :TOGGLE-BUTTON :LABEL "Does it have pointer documentation?" :VALUE T)
           (MENU-BAR-TOGGLE :TOGGLE-BUTTON :LABEL "A menu bar?" :VALUE T)
           (EXTANT-GUI-LIST :LIST-PANE :ITEMS EXTANT-GUIS :MIN-WIDTH 100 :MIN-HEIGHT 50 :MAX-HEIGHT 100)
           (MODIFY-GUI-BUTTON :PUSH-BUTTON :LABEL "Modify") (CLONE-GUI-BUTTON :PUSH-BUTTON :LABEL "or Clone")
           (NEW-GUI-TEXT-FIELD :TEXT-FIELD :VALUE "Name of new GUI" :VALUE-CHANGED-CALLBACK 'MASAMUNE::NOPE :WIDTH TEXT-FIELD-WIDTH :MAX-WIDTH
                               TEXT-FIELD-WIDTH :MIN-WIDTH TEXT-FIELD-WIDTH :HEIGHT 40 :MAX-HEIGHT 40 :MIN-HEIGHT 40)
           (NEW-GUI-BUTTON :PUSH-BUTTON :LABEL "Create" :ACTIVATE-CALLBACK 'CREATE-NEW-GUI)
           (LEFT-SPACING :APPLICATION :SCROLL-BARS NIL :MIN-WIDTH X-PADDING :MAX-WIDTH X-PADDING :BORDER-WIDTH 0)
           (RIGHT-SPACING :APPLICATION :SCROLL-BARS NIL :MIN-WIDTH X-PADDING :MAX-WIDTH X-PADDING :BORDER-WIDTH 0)
           (TOP-SPACING :APPLICATION :SCROLL-BARS NIL :MIN-WIDTH Y-PADDING :MAX-WIDTH Y-PADDING :BORDER-WIDTH 0)
           (BOTTOM-SPACING :APPLICATION :SCROLL-BARS NIL :MIN-WIDTH Y-PADDING :MAX-WIDTH Y-PADDING :BORDER-WIDTH 0)
           (OR-LABEL :LABEL :LABEL "OR" :ALIGN-X :CENTER :ALIGN-Y :CENTER :TEXT-STYLE (MAKE-TEXT-STYLE :SANS-SERIF :BOLD 40))
           (USER-VISIBLE-PANES :LIST-PANE :ITEMS USER-VISIBLE-PANE-TYPES)
           (LIVE-MODIFICATION-ROOT :APPLICATION :SCROLL-BARS NIL :DISPLAY-FUNCTION 'RENDER-LIVE-MODIFICATION-PANE))

   (:LAYOUTS
    (:GUI-DERIVATION
     (HORIZONTALLY NIL
       (1/5
        (VERTICALLY NIL
          (300
           (LABELLING (:LABEL "DERIVE A GUI" :ALIGN-X :CENTER :TEXT-STYLE (MAKE-TEXT-STYLE :SANS-SERIF :BOLD 30))
             (VERTICALLY NIL
               (LABELLING (:LABEL "Is this GUI an,")
                 (HORIZONTALLY NIL
                   (270 ESA-TOGGLE)
                   (300 POINTER-DOC-TOGGLE)
                   (200 MENU-BAR-TOGGLE)))
               20
               (HORIZONTALLY NIL
                 (1/3
                  (LABELLING (:LABEL "An existing GUI" :LABEL-ALIGNMENT :BOTTOM :ALIGN-X :CENTER)
                    (VERTICALLY NIL
                      (SCROLLING (:TYPE :VERTICAL)
                        EXTANT-GUI-LIST)
                      (22
                       (HORIZONTALLY NIL
                         (155 MODIFY-GUI-BUTTON)
                         (155 CLONE-GUI-BUTTON))))))
                 (100 OR-LABEL)
                 (1/3
                  (LABELLING (:LABEL "A new GUI" :LABEL-ALIGNMENT :BOTTOM :ALIGN-X :CENTER)
                    (VERTICALLY NIL
                      NEW-GUI-TEXT-FIELD
                      NEW-GUI-BUTTON)))))))))))
    (:LIVE-MODIFICATION
     (VERTICALLY NIL
       LIVE-MODIFICATION-ROOT))))
 (DEFUN GUI-BUILDER-FRAME ()
   "XXX, for some reason this does not work when evaluated in the 
editor, but does when evaluated in the listener"
   (FIND 'GUI-BUILDER (SLOT-VALUE (FIND-FRAME-MANAGER) 'CLIM-INTERNALS::FRAMES) :KEY 'CLIM:FRAME-NAME))
 (DEFUN RUN-GUI-BUILDER () (RUN-FRAME-TOP-LEVEL (MAKE-APPLICATION-FRAME 'GUI-BUILDER) :NAME "GUI-BUILDER"))
 (DEFUN RUN-OR-FOCUS-GUI-BUILDER ()
   (AIF (STUMPWM::WINDOW-BY-NAME "GUI-BUILDER") (STUMPWM:SELECT-WINDOW (STUMPWM::WINDOW-NAME IT))
        (BORDEAUX-THREADS:MAKE-THREAD 'RUN-GUI-BUILDER :NAME "GUI-BUILDER")))
 (CLIM-LISTENER::DEFINE-LISTENER-COMMAND (COM-RUN-GUI-BUILDER :NAME T) NIL (RUN-OR-FOCUS-GUI-BUILDER))
 NIL)  

(defun create-new-gui (this)
  (declare (ignore this))
  (let* ((menu-bar? (find-pane-named *application-frame* 'menu-bar-toggle))
         (esa-gui? (find-pane-named *application-frame* 'esa-toggle))
         (pointer-documentation? (find-pane-named *application-frame* 'pointer-doc-toggle))
         (gui-name (string-upcase (gadget-value (find-pane-named *application-frame* 'new-gui-text-field)))))
    (if (scan #\space gui-name)         
        (stumpwm::message "spaces are allowed in the name of the GUI!")
        (progn (setf gui-sexpr
                     `(gui ,(intern gui-name 'mmg) nil :esa-gui? ,esa-gui?
                        (:menu-bar ,menu-bar?)
                        (:pointer-documentation ,pointer-documentation?)))               
               (SETF (frame-current-layout (GUI-BUILDER-FRAME)) :LIVE-MODIFICATION)))))

(defun modify-scrollbar (radio-box-pane selected-gadget)
  (let* ((scroller-type (read-from-string (gadget-label selected-gadget)))
         (scroller-type (ecase scroller-type
                          (nil nil)
                          (:vertical scroller-type)
                          (:horizontal scroller-type)
                          (:both t))))
    (if scroller-type
        (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
          (let* ((unspecialized-pane (sheet-parent (sheet-parent radio-box-pane)))
                 (parent (sheet-parent unspecialized-pane)))
            (sheet-disown-child parent unspecialized-pane)
            (let* ((viewport (make-pane 'clim-extensions::viewport-pane
                                        :contents (list unspecialized-pane)))
                   (scrollbar-pane (make-pane 'scroller-pane
                                              :contents (list viewport)
                                              :scroll-bar scroller-type)))
              (sheet-adopt-child parent scrollbar-pane)
              (redisplay-frame-panes *application-frame*))))
        (message "nope.jpg"))))

(defun rack-parent (pane)
  "Returns the parent and its disownable child as VALUES"
  ;; see MAKE-THIS-A-TAB-PANE, this returns the wrong thing
  (loop with parents-disownable-child = pane
        with parent = (sheet-parent parents-disownable-child)
        while (not (or (eq 'clim:vrack-pane (type-of parent))
                       (eq 'clim:hrack-pane (type-of parent))))
        do (setf parent-disownable-child parent
                 parent (sheet-parent parent))
        finally (return (values parent parents-disownable-child))))

(defun make-this-a-tab-pane (this-gadget)
  (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
    (let* ((first-tab-child (sheet-parent this-gadget)) ;; should be live modification root
           (second-tab-child 
            (make-pane 'application-pane 
                       :display-function (lambda (frame pane)
                                           (declare (ignore frame))
                                           (with-centers pane
                                             (draw-text* pane "I live to serve" center-x center-y 
                                                         :text-size 30))))))
      (multiple-value-bind (parent disownable-child)
          (rack-parent first-tab-child)
        ;; vrack-pane
        ;; ahaha, so the thing is that vrack pane does not have children, it has a list of contents
        (sheet-disown-child parent (sheet-parent disownable-child))
        ;; the name of this tab-layout-pane needs to be auto-generated so we can find-frame it 
        (sheet-adopt-child parent (with-tab-layout ('tab-page :name 'gui-builder-layout) 
                                    ("First Tab" (sheet-parent first-tab-child))
                                    ("Second Tab" second-tab-child)))
        (redisplay-frame-panes *application-frame*)))))

(defun sheet-child-containing (parent-sheet child-sheet)
  "Returns NIL if the child is not found in the parent's decendents"
  (loop for last-seen-child = child-sheet then (sheet-parent last-seen-child)
        while (not (climi::top-level-sheet-pane-p last-seen-child))
        do (when (eq parent-sheet (sheet-parent last-seen-child))
             (return-from sheet-child-containing last-seen-child))))

(defun sheet-disown-child-containing (parent-sheet child-sheet)
  "When one wishes to disown a sheet from its parent and traverses the sheet 
heigharcy using SHEET-PARENT he will sometimes find that his sheet is distanced
from the VRACK-PANE (or whatever) by border-panes, viewports, scrollbars etc.

SHEET-DISOWN-CHILD-CONTAINING searches from the parent in question down to the 
child sheet and then disowns the tree containing it, returning the tree in 
question

Tastes great with RACK-PARENT, which can be used to locate the parent one wants
to disown from"
  (awhen (sheet-child-containing parent-sheet child-sheet)
    (sheet-disown-child parent-sheet it)
    it))

(defun new-unspecialized-pane ()
  (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
    (make-pane 'application-pane 
               :display-function (lambda (frame pane)
                                   (declare (ignore frame))
                                   (with-centers pane
                                     (draw-text* pane "I live to serve" center-x center-y 
                                                 :text-size 20))))))

(macrolet 
  ;; TODO, @2016-07-15T12:43:29.061876Z
  ;; - does not split the pane inside the tab if we're in a tab layout.
  ;;   should detect and add a surrounding v/hbox-pane
  ((m (name pane-type)
      `(defun ,(alexandria::format-symbol t "SPLIT-~A" name) (this-gadget)
         (with-look-and-feel-realization ((find-frame-manager) *application-frame*)
           (let* ((unspecialized-pane (sheet-parent this-gadget))
                  (parent (rack-parent unspecialized-pane))
                  (unspecialized-pane-container 
                   (sheet-disown-child-containing parent unspecialized-pane)) ;; returns the border pane we stick in the vrack
                  (new-rack-pane (make-pane ',pane-type
                                            :contents (list unspecialized-pane-container
                                                            (new-unspecialized-pane)))))
             (sheet-adopt-child parent new-rack-pane)
             (redisplay-frame-panes *application-frame*))))))
  (m vertically vrack-pane)
  (m horizontally hrack-pane))

(define-gui-builder-command (com-add-unspecialized-tab-page)
                            ((tab-page 'tab-page :gesture :delete))
                            (let* ((tab-layout-pane (clim-tab-layout::tab-page-tab-layout tab-page))
                                   (new-tab-page (clim-tab-layout::make-tab-page (symbol-name (gensym))
                                                                                 (new-unspecialized-pane))))
                              (add-page new-tab-page tab-layout-pane t)))

(defun remove-this-pane (this-gadget)
  (stumpwm::message "implement me!"))

(defun render-live-modification-pane (frame pane)
  ;; Then proceeds to specialize mmg::unspecialized-pane
  ;; - tabpane, further split? specialize against any
  ;;   other pane or gadget type?
  ;; - w/h, min max on each
  ;; - create, reuse existing render routine
  ;; - scrollbars
  ;; - modify whatever defmethod calls `display-function' so that we can
  ;;   print errors to the pane (or bubble them up) according to
  ;;   'store-conditions-to-pane?'
  ;; - add draggable box one or more sides.
  ;;
  ;; or we could allocate some space?
  (setf (stream-cursor-position pane)
        (values 300 300)
        (stream-cursor-position pane)
        (values 10 10))
  (with-look-and-feel-realization ((find-frame-manager) frame)
     (let* ((stream pane)
            (scroll-bars-radio (labelling (:label "scroll bars"
                                                  :align-x :center)
                                (with-radio-box (:orientation :horizontal
                                                              :parent stream
                                                              :value-changed-callback 'modify-scrollbar)
                                 ":BOTH"
                                 ":VERTICAL"
                                 ":HORIZONTAL"
                                  (climi::radio-box-current-selection "NIL"))))
            (render-routine-button
             (make-pane 'push-button
                        :label "Create / Modify a Rendering Routine"
                        :activate-callback (lambda (_) (clim-demo::clim-fig))
                        :parent stream))
            
            (make-it-a-tab-pane-button
             (make-pane 'push-button
              :label "Make it a Tab Pane"
              :activate-callback 'make-this-a-tab-pane))
            
            (hsplit-button
             (make-pane 'push-button
              :label "Split Horizontally"
              :activate-callback 'split-horizontally))
            
            (vsplit-button
             (make-pane 'push-button
              :label "Split Vertically"
              :activate-callback 'split-vertically))
            
            (remove-button
             (make-pane 'push-button
              :label "Remove Pane"
              :activate-callback 'remove-this-pane)))
      (dolist (gadget (list scroll-bars-radio
                            render-routine-button
                            make-it-a-tab-pane-button
                            hsplit-button
                            vsplit-button
                            remove-button))
        (with-output-as-gadget (stream) gadget)
        ;; can call SHEET-REGION on the output, and use the height to calculate
        ;; exactly how far to y step
        (with-cursor-position stream
                              (setf (stream-cursor-position stream) (values 10 cy)))))))

;;; Rendering routine nonsense
;;; ============================================================================

; (ed #P(:p ("McCLIM" "Examples") "clim-fig.lisp"))

;; this relies on the `push'ing each drawn thing from CLIM-DEMO::CLIM-FIG onto
;; CLIM-DEMO::DRAWING-SEXPRS
#+nil(defun generate-display-function-sexpr (frame pane)
  (let* ((sexpr-skeleton clim-demo::drawing-sexprs)
         (generated-code-path #P"/tmp/gui-builder-genertaed-functions.lisp") 
         (display-function-name))
    (with-open-file (s generated-code-path 
                     :if-exists :append
                     :if-does-not-exist :create)
      (format s "~&~S~%"
              (append (list 'defun display-function-name '(frame pane))
                      sexpr-skeleton)))
    (compile-file generated-code-path)
    (setf clim-demo::drawing-sexprs nil
          (climi::pane-display-function pane) display-function-name)))

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.