Commit 7fbf831c authored by David O'Toole's avatar David O'Toole

testing works

parent 097a315d
......@@ -780,7 +780,7 @@
(defmethod layout ((self menubar))
(with-slots (x y width height inputs) self
(setf x 0 y 0 width *screen-width* height (dash 1))
(setf x (window-x) y (window-y) width *screen-width* height (dash 1))
(let ((x1 (dash 1)))
(dolist (item inputs)
(move-to item x1 y)
......
......@@ -201,6 +201,9 @@
;; Visiting buffers
;; Here we make sure that any hanging menus are closed after switching
;; buffers.
;; [[file:~/xelf/gui.org::*Visiting%20buffers][Visiting buffers:1]]
(defmethod visit ((buffer buffer))
......@@ -229,13 +232,21 @@
(t (with-shell (shell-prompt))))))
(when (find-object node :noerror)
(handle-event (find-object node) event)))))))))
;; Handling events:1 ends here
;; Capturing ESCAPE key to exit shell
;; When a game's BUFFER subclass has bound the ESCAPE key, we want to
;; trap that to close the shell in the case that it is open.
;; [[file:~/xelf/gui.org::*Capturing%20ESCAPE%20key%20to%20exit%20shell][Capturing ESCAPE key to exit shell:1]]
(defmethod handle-event :around ((self buffer) event)
(if (and (eq :escape (first (first event)))
(shell-p self))
(close-shell self)
(call-next-method)))
;; Handling events:1 ends here
;; Capturing ESCAPE key to exit shell:1 ends here
;; Finding and indexing buffers by name
......@@ -597,8 +608,8 @@
(when (holding-shift) drag)
point)))
(when (xelfp thing)
(glide-follow self thing)
(update-window-glide self)))))
(glide-follow self thing))
(update-window-glide self))))
(defmethod scale-window ((self buffer) &optional (window-scale-x 1.0) (window-scale-y 1.0))
(setf (slot-value self 'window-scale-x) window-scale-x)
......@@ -1381,11 +1392,6 @@
((or (= button 2)
(and (holding-shift) (= button 1)))
(scroll-tap self x y))
;; vertical scrolling with mousewheel
((= button 4)
(scroll-up self))
((= button 5)
(scroll-down self))
;; horizontal scrolling with shift-mousewheel
((and (= button 4)
(holding-shift))
......@@ -1393,6 +1399,11 @@
((and (= button 5)
(holding-shift))
(scroll-right self))
;; vertical scrolling with mousewheel
((= button 4)
(scroll-up self))
((= button 5)
(scroll-down self))
;; plain old click
(t
(process-tap self it x y)))))
......@@ -1415,7 +1426,7 @@
(defmethod alternate-tap ((self buffer) x y)
(show-context-menu self))
(defmethod scroll-distance ((self buffer) direction) 10)
(defmethod scroll-distance ((self buffer) direction) 40)
(defmethod scroll-position ((self buffer) x y direction)
(let ((distance (scroll-distance self direction)))
......@@ -1426,7 +1437,7 @@
(:right (values (+ x distance) y)))))
(defmethod scroll-tap ((self buffer) x y)
(snap-window-to self 0 0))
(move-window-to self 0 0))
(defmethod scroll ((self buffer) direction)
(multiple-value-bind (x y)
......
......@@ -247,6 +247,9 @@ See also "Command shell" below.
** Visiting buffers
Here we make sure that any hanging menus are closed after switching
buffers.
#+begin_src lisp
(defmethod visit ((buffer buffer))
(when (shell-p buffer)
......@@ -273,7 +276,14 @@ See also "Command shell" below.
(t (with-shell (shell-prompt))))))
(when (find-object node :noerror)
(handle-event (find-object node) event)))))))))
#+end_src
*** Capturing ESCAPE key to exit shell
When a game's BUFFER subclass has bound the ESCAPE key, we want to
trap that to close the shell in the case that it is open.
#+begin_src lisp
(defmethod handle-event :around ((self buffer) event)
(if (and (eq :escape (first (first event)))
(shell-p self))
......@@ -631,8 +641,8 @@ Destroy the objects intersecting the region, without selecting them.
(when (holding-shift) drag)
point)))
(when (xelfp thing)
(glide-follow self thing)
(update-window-glide self)))))
(glide-follow self thing))
(update-window-glide self))))
(defmethod scale-window ((self buffer) &optional (window-scale-x 1.0) (window-scale-y 1.0))
(setf (slot-value self 'window-scale-x) window-scale-x)
......@@ -1401,11 +1411,6 @@ This section is obsolete and will be removed in the future.
((or (= button 2)
(and (holding-shift) (= button 1)))
(scroll-tap self x y))
;; vertical scrolling with mousewheel
((= button 4)
(scroll-up self))
((= button 5)
(scroll-down self))
;; horizontal scrolling with shift-mousewheel
((and (= button 4)
(holding-shift))
......@@ -1413,6 +1418,11 @@ This section is obsolete and will be removed in the future.
((and (= button 5)
(holding-shift))
(scroll-right self))
;; vertical scrolling with mousewheel
((= button 4)
(scroll-up self))
((= button 5)
(scroll-down self))
;; plain old click
(t
(process-tap self it x y)))))
......@@ -1435,7 +1445,7 @@ This section is obsolete and will be removed in the future.
(defmethod alternate-tap ((self buffer) x y)
(show-context-menu self))
(defmethod scroll-distance ((self buffer) direction) 10)
(defmethod scroll-distance ((self buffer) direction) 40)
(defmethod scroll-position ((self buffer) x y direction)
(let ((distance (scroll-distance self direction)))
......@@ -1446,7 +1456,7 @@ This section is obsolete and will be removed in the future.
(:right (values (+ x distance) y)))))
(defmethod scroll-tap ((self buffer) x y)
(snap-window-to self 0 0))
(move-window-to self 0 0))
(defmethod scroll ((self buffer) direction)
(multiple-value-bind (x y)
......@@ -5405,7 +5415,7 @@ supported compiler.
(defmethod layout ((self menubar))
(with-slots (x y width height inputs) self
(setf x 0 y 0 width *screen-width* height (dash 1))
(setf x (window-x) y (window-y) width *screen-width* height (dash 1))
(let ((x1 (dash 1)))
(dolist (item inputs)
(move-to item x1 y)
......
......@@ -102,6 +102,10 @@
(trace xelf::scroll-position)
(trace xelf::scroll-distance)
(trace xelf::scroll)
(trace xelf::scroll-up)
(trace xelf::scroll-down)
(trace xelf::scroll-left)
(trace xelf::scroll-right)
;; (untrace xelf::layout)
;; (trace xelf::draw-cell)
......@@ -110,5 +114,8 @@
;; (trace xelf::draw-string-in-cell)
;; (trace xelf::draw-row-header)
;; (trace xelf::draw-column-header)
;; (trace xelf::update-window-movement)
(squareball:squareball)
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