Commit 55f039a3 authored by David O'Toole's avatar David O'Toole

fix menubar

parent 78176cef
......@@ -64,6 +64,9 @@
(move-to self (window-x) (- (+ (window-y) *screen-height*) (slot-value self 'height)))
(resize self *screen-width* (slot-value self 'height)))
(defmethod layout :after ((self shell))
(when *menubar* (layout *menubar*)))
(defmethod insert-output ((self shell) item)
(unfreeze (input-node self :output))
(accept (input-node self :output) item)
......@@ -455,7 +458,7 @@
(defparameter *system-menu* (system-menu-entries))
;; Menu bar structure:1 ends here
;; Menubar class
;; TODO Menubar class
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*Menubar%20class][Menubar class:1]]
......@@ -476,7 +479,6 @@
(defmethod initialize-instance :after ((self menubar) &key (menus *system-menu*))
(with-slots (inputs) self
(setf *menubar* self)
(layout self)
(setf inputs (make-menu menus))
(dolist (each inputs)
......@@ -557,8 +559,10 @@
(mapc #'unexpand inputs))))
(defmethod tap ((self menubar) x y)
(declare (ignore x y))
(close-menus self))
(let ((target (hit self x y)))
(when (not (object-eq target self))
(tap target x y))
(close-menus self)))
;; Don't allow anything to be dropped on the menus, for now.
......
......@@ -992,6 +992,11 @@
(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*)
(update *shell*)))
;; System update triggers:1 ends here
;; [[file:~/quicklisp/local-projects/xelf/gui.org::*System%20update%20triggers][System update triggers:2]]
......@@ -1325,7 +1330,8 @@
(defmethod release :around ((self buffer) x y &optional buttom)
(with-shell (call-next-method)))
(defmethod tap ((self buffer) x y) ())
(defmethod tap ((self buffer) x y)
(with-shell (when *menubar* (close-menus *menubar*))))
(defmethod alternate-tap ((self buffer) x y))
(defmethod scroll-tap ((self buffer) x y))
(defmethod scroll-up ((self buffer)))
......@@ -2274,14 +2280,18 @@ See sidebar for more commands to try.
;; fixme
(defmethod draw :after ((self buffer))
(when *notification*
(draw *notification*)))
(draw *notification*))
(when *menubar*
(draw *menubar*))
(when *shell*
(draw *shell*)))
(defmethod tap ((self prompt) mouse-x mouse-y)
(declare (ignore mouse-y))
(with-slots (x y width height clock point parent background
line) self
;; find the left edge of the data area
(let* ((left (+ x (label-width self) (dash 4)))
(let* ((left (+ x (label-width self) (dash 3)))
(tx (- mouse-x left)))
;; which character was clicked?
(let ((click-index
......
......@@ -1018,6 +1018,11 @@ 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*)
(update *shell*)))
#+end_src
#+begin_src lisp
......@@ -1348,7 +1353,8 @@ This section is obsolete and will be removed in the future.
(defmethod release :around ((self buffer) x y &optional buttom)
(with-shell (call-next-method)))
(defmethod tap ((self buffer) x y) ())
(defmethod tap ((self buffer) x y)
(with-shell (when *menubar* (close-menus *menubar*))))
(defmethod alternate-tap ((self buffer) x y))
(defmethod scroll-tap ((self buffer) x y))
(defmethod scroll-up ((self buffer)))
......@@ -2287,7 +2293,11 @@ above.
;; fixme
(defmethod draw :after ((self buffer))
(when *notification*
(draw *notification*)))
(draw *notification*))
(when *menubar*
(draw *menubar*))
(when *shell*
(draw *shell*)))
(defmethod tap ((self prompt) mouse-x mouse-y)
(declare (ignore mouse-y))
......@@ -4494,8 +4504,9 @@ supported compiler.
(make-label *default-command-prompt-string*)
(make-instance 'shell-prompt)))))
(at-next-update (evaluate-expression (shell-prompt) (list 'in-package (package-name (project-package)))))
(at-next-update (add-node (current-buffer) (make-instance 'menubar)))
(at-next-update (setf *system* (make-instance 'system))))
(setf *menubar* (make-instance 'menubar))
(at-next-update (add-node (current-buffer) *menubar*))
(setf *system* (make-instance 'system)))
(defun create-shell-maybe ()
(when (null *shell*)
......@@ -4566,6 +4577,9 @@ supported compiler.
(move-to self (window-x) (- (+ (window-y) *screen-height*) (slot-value self 'height)))
(resize self *screen-width* (slot-value self 'height)))
(defmethod layout :after ((self shell))
(when *menubar* (layout *menubar*)))
(defmethod insert-output ((self shell) item)
(unfreeze (input-node self :output))
(accept (input-node self :output) item)
......@@ -5080,7 +5094,7 @@ supported compiler.
#+end_src
** Menubar class
** TODO Menubar class
#+begin_src lisp :tangle commands.lisp
......@@ -5101,7 +5115,6 @@ supported compiler.
(defmethod initialize-instance :after ((self menubar) &key (menus *system-menu*))
(with-slots (inputs) self
(setf *menubar* self)
(layout self)
(setf inputs (make-menu menus))
(dolist (each inputs)
......@@ -5182,8 +5195,10 @@ supported compiler.
(mapc #'unexpand inputs))))
(defmethod tap ((self menubar) x y)
(declare (ignore x y))
(close-menus self))
(let ((target (hit self x y)))
(when (not (object-eq target self))
(tap target x y))
(close-menus self)))
;; Don't allow anything to be dropped on the menus, for now.
......
......@@ -227,8 +227,9 @@
(make-label *default-command-prompt-string*)
(make-instance 'shell-prompt)))))
(at-next-update (evaluate-expression (shell-prompt) (list 'in-package (package-name (project-package)))))
(at-next-update (add-node (current-buffer) (make-instance 'menubar)))
(at-next-update (setf *system* (make-instance 'system))))
(setf *menubar* (make-instance 'menubar))
(at-next-update (add-node (current-buffer) *menubar*))
(setf *system* (make-instance 'system)))
(defun create-shell-maybe ()
(when (null *shell*)
......
......@@ -26,7 +26,7 @@
(switch-to-buffer plong)
(at-next-update
;; (add-node (current-buffer) (make-instance 'xelf::resize-buffer-dialog) 200 200)
(xelf::show-buffer-properties-dialog (current-buffer))
;;(xelf::show-buffer-properties-dialog (current-buffer))
(bind-event (current-buffer) '(:f9) 'xelf::toggle-other-windows)
(start-game plong)))))
......@@ -51,5 +51,8 @@
;; (trace xelf::layout)
(trace xelf::backtab)
(trace xelf::handle-event)
(trace xelf::do-show-buffer-properties-dialog)
(trace xelf::show-buffer-properties-dialog)
(trace xelf::close-menus)
(test-gui)
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