Commit c6c0f177 authored by David O'Toole's avatar David O'Toole

fix menubar/shell widgets being embedded in buffer

parent 7f3c1682
......@@ -633,11 +633,27 @@
(defparameter *system-menu* (system-menu-entries))
;; Menu bar structure:1 ends here
;; TODO Menubar class
;; Traveling nodes
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Traveling%20nodes][Traveling nodes:1]]
(defclass traveler (node)
((parent-buffer :initform nil)))
(defmethod add-node :before ((new-buffer buffer) (traveler traveler) &optional x y z)
(with-slots (parent-buffer) traveler
(when (and (not (null parent-buffer))
(xelfp parent-buffer)
(not (object-eq new-buffer parent-buffer)))
(remove-node parent-buffer traveler)
(setf parent-buffer new-buffer))))
;; Traveling nodes:1 ends here
;; Menubar class
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Menubar%20class][Menubar class:1]]
(defclass menubar (tree)
(defclass menubar (tree traveler)
((category :initform :menu)
(temporary :initform t)))
......
......@@ -651,11 +651,8 @@
(z-sort-p self))
(draw-object-layer-z-sorted self)
(draw-object-layer self))
;; draw shell
(with-shell
(when (shell-p self)
(draw *shell*)
(draw-region self)))
(draw-region self))
(mapc #'draw inputs)
(when drag
(layout drag)
......@@ -999,7 +996,7 @@
(update-window-movement buffer)
(let ((selection (selection)))
(when selection (mapc #'layout selection))))
(defmethod update :after ((buffer buffer))
(when (and *shell* (shell-p buffer))
(layout *shell*)
......@@ -1059,7 +1056,8 @@
(let ((parent
(find-if #'try
(if (shell-p self)
(with-shell (append (slot-value self 'inputs) (list *shell*)))
(with-shell (append (slot-value self 'inputs)
(list *shell* *menubar*)))
(slot-value self 'inputs))
:from-end t)))
(when parent
......@@ -2286,8 +2284,7 @@ See sidebar for more commands to try.
(defmethod draw :after ((self prompt))
(when *notification*
(layout *notification*)
(draw *notification*))
(layout *notification*))
(let ((text (find-instances 'text (current-buffer))))
(when text
(mapc #'draw text))))
......@@ -3369,7 +3366,7 @@ See sidebar for more commands to try.
(dash 1)
:blink t)))))
(defmethod draw-point ((self entry))
(defmethod draw-point ((self entry))
(with-slots (x y width height) self
(draw-box x y width height
:color "white"
......
......@@ -682,11 +682,8 @@ This section is obsolete and will be removed in the future.
(z-sort-p self))
(draw-object-layer-z-sorted self)
(draw-object-layer self))
;; draw shell
(with-shell
(when (shell-p self)
(draw *shell*)
(draw-region self)))
(draw-region self))
(mapc #'draw inputs)
(when drag
(layout drag)
......@@ -1027,7 +1024,7 @@ This section is obsolete and will be removed in the future.
(update-window-movement buffer)
(let ((selection (selection)))
(when selection (mapc #'layout selection))))
(defmethod update :after ((buffer buffer))
(when (and *shell* (shell-p buffer))
(layout *shell*)
......@@ -1086,7 +1083,8 @@ This section is obsolete and will be removed in the future.
(let ((parent
(find-if #'try
(if (shell-p self)
(with-shell (append (slot-value self 'inputs) (list *shell*)))
(with-shell (append (slot-value self 'inputs)
(list *shell* *menubar*)))
(slot-value self 'inputs))
:from-end t)))
(when parent
......@@ -2301,8 +2299,7 @@ above.
(defmethod draw :after ((self prompt))
(when *notification*
(layout *notification*)
(draw *notification*))
(layout *notification*))
(let ((text (find-instances 'text (current-buffer))))
(when text
(mapc #'draw text))))
......@@ -2311,8 +2308,8 @@ above.
(defmethod draw :after ((self buffer))
(when *menubar*
(draw *menubar*))
;; (when (shell-p self)
;; (draw *shell*))
(when (shell-p self)
(draw *shell*))
(when *notification*
(draw *notification*)))
......@@ -3381,7 +3378,7 @@ supported compiler.
(dash 1)
:blink t)))))
(defmethod draw-point ((self entry))
(defmethod draw-point ((self entry))
(with-slots (x y width height) self
(draw-box x y width height
:color "white"
......@@ -4468,6 +4465,9 @@ supported compiler.
(background :initform nil)
(history :initform nil)))
(defmethod make-halo ((self shell-prompt))
nil)
(defmethod can-pick ((self shell-prompt)) nil)
(defmethod pick ((self shell-prompt))
......@@ -4514,7 +4514,7 @@ supported compiler.
(setf (slot-value label 'font) font)))))
(define-visual-macro shell
(:super phrase
(:super (phrase traveler)
:slots
((orientation :initform :vertical)
(frozen :initform t)
......@@ -4533,7 +4533,6 @@ supported compiler.
(make-instance 'shell-prompt)))))
(at-next-update (evaluate-expression (shell-prompt) (list 'in-package (package-name (project-package)))))
(setf *menubar* (make-instance 'menubar))
(at-next-update (add-node (current-buffer) *menubar*))
(setf *system* (make-instance 'system)))
(defun create-shell-maybe ()
......@@ -5172,11 +5171,26 @@ supported compiler.
#+end_src
** TODO Menubar class
** Traveling nodes
#+begin_src lisp :tangle commands.lisp
(defclass traveler (node)
((parent-buffer :initform nil)))
(defmethod add-node :before ((new-buffer buffer) (traveler traveler) &optional x y z)
(with-slots (parent-buffer) traveler
(when (and (not (null parent-buffer))
(xelfp parent-buffer)
(not (object-eq new-buffer parent-buffer)))
(remove-node parent-buffer traveler)
(setf parent-buffer new-buffer))))
#+end_src
** Menubar class
#+begin_src lisp :tangle commands.lisp
(defclass menubar (tree)
(defclass menubar (tree traveler)
((category :initform :menu)
(temporary :initform t)))
......
......@@ -165,6 +165,9 @@
(background :initform nil)
(history :initform nil)))
(defmethod make-halo ((self shell-prompt))
nil)
(defmethod can-pick ((self shell-prompt)) nil)
(defmethod pick ((self shell-prompt))
......@@ -211,7 +214,7 @@
(setf (slot-value label 'font) font)))))
(define-visual-macro shell
(:super phrase
(:super (phrase traveler)
:slots
((orientation :initform :vertical)
(frozen :initform t)
......@@ -230,7 +233,6 @@
(make-instance 'shell-prompt)))))
(at-next-update (evaluate-expression (shell-prompt) (list 'in-package (package-name (project-package)))))
(setf *menubar* (make-instance 'menubar))
(at-next-update (add-node (current-buffer) *menubar*))
(setf *system* (make-instance 'system)))
(defun create-shell-maybe ()
......
* Task list
** TODO switch to menubar and shell not being in buffer
*** DONE fix updating
CLOSED: [2017-04-21 Fri 08:15]
*** DONE fix drawing
CLOSED: [2017-04-21 Fri 08:15]
*** TODO fix clicks/focus
** TODO fix dialog boxes
*** TODO [#A] context-menu with reset-to-current-values
**** TODO pin down context menu elements
**** TODO fix broken layout/rendering of context menu
*** TODO [#A] fix command line has no cursor
*** TODO [#A] fix menubar not being in switched-to buffer to respond to clicks
*** TODO [#A] project properties: height width scale-output- resizable author title license frame-rate
*** TODO [#B] add more notifications for cut/copy etc
......@@ -768,3 +774,13 @@
:ARCHIVE_CATEGORY: tasks
:ARCHIVE_TODO: DONE
:END:
** DONE [#A] fix command line has no cursor
CLOSED: [2017-04-21 Fri 07:53]
:PROPERTIES:
:ARCHIVE_TIME: 2017-04-21 Fri 08:12
:ARCHIVE_FILE: ~/xelf/tasks.org
:ARCHIVE_OLPATH: Task list/fix dialog boxes
:ARCHIVE_CATEGORY: tasks
:ARCHIVE_TODO: DONE
:END:
......@@ -16,7 +16,7 @@
(setf *screen-height* 450)
(setf *resizable* t)
(setf *scale-output-to-window* nil)
(setf *debug-on-error* t)
(setf *debug-on-error* nil)
(setf *shell-enabled-p* t)
(with-session
(open-project :plong)
......
......@@ -5642,7 +5642,7 @@ Returns a newly allocated list."
"
(let ((input-names (remove-if-not #'keywordp inputs)))
`(progn
(defclass ,name (,super)
(defclass ,name ,(if (symbolp super) (list super) super)
((caption :initform ,(pretty-string name))
(input-names :initform ',input-names)
,@slots))
......
......@@ -5623,7 +5623,7 @@ in the future.
"
(let ((input-names (remove-if-not #'keywordp inputs)))
`(progn
(defclass ,name (,super)
(defclass ,name ,(if (symbolp super) (list super) super)
((caption :initform ,(pretty-string name))
(input-names :initform ',input-names)
,@slots))
......@@ -6159,6 +6159,7 @@ The Buffer class documentation continues on the [[file:gui.html][GUI page]].
Please see the [[file:gui.html][GUI page]] for code and documentation.
* Facade objects
** Project object
#+begin_src lisp
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment