#|
Summary
Convert a pointer interface into a selection interface.
Each point is then available as next or prior.
Eliminate traversal of a vast void, and never miss
a point.
Convert "drag and drop" into "select and put"
by adding pointer button activation commands
for toggling the press or release of
the primary pointer button.
First, move the Xserver cursor by whatever means available,
then mark the location for returning the cursor to it later.
* Collect and mark the coordinates
of the Xserver cursor.
* Select the next/prior sequential point
and the cursor is moved to it,
even when points are hidden.
* Activate a pointer button from the buttonboard
at location of cursor.
(Independent of points. Consider adding commands
for pointer button activation.
* Hide all points. Show all points
and the cursor is immediately moved
to the most recently selected point.
* Remove a visible point when no longer needed,
then the next point becomes the selected point
(which also moves the cursor to it).
Showing and hiding points is respected as purposely done,
rather than automated. Moving the cursor to each point
is possible regardless of visibility of the points.
Marking a new point is possible when no points are marked,
f.e. after removal of final point. Thereafter, marking
is restricted to only when the points are visible,
just like when removing a point.
Thereby, the points remain hidden as requested
rather than automatically revealed. There is
no need of wrestling for an unobtrusive interface
transparently overlaying the programs.
A collection of Xserver cursor coordinates is retained
as a foldable list within the 'points.nu property
of the plist of the root Xwindow for a screen.
For example, consider evaluating a lisp form
for obtaining the points for the current screen:
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu)
|#
#|
This emerges in the universe on its own, as all has.
|#
#|
Content outline
* Requirements
* The visual shape for a point
* General function use and naming conventions
* Ancillary functions for a foldable list, a.k.a. foldy.
(Independent from symbols of this document.)
* defun fold-one.nu
Move first item of second half to first half.
* defun fold-all.nu
Move all items from second half to first half.
* defun unfold-one.nu
Move first item of first half to second half.
* defun unfold-all.nu
Move all items from first half to second half.
* CLX root Xwindow plist property 'points.nu
* Description and access for 'points.nu
* All functions that directly modify 'points.nu
* defun points-init.nu
Initiate 'points.nu for the screen.
* defun points-drawing.nu
Initiate the point for the screen.
* Complementary functions.
These isolate instructions particular to 'points.nu
and were consistently repeated in other functions.
* defun points-viewablep.nu
Determine whether points are viewable.
* defun points-prioritize.nu
Highest priority for all points.
* defun points-draw.nu
Draw the collected points of current screen.
* defun points-move-cursor.nu
Move Xserver cursor to current point.
* Functions for StumpWM hooks.
* defun points-new-window-hook.nu
Ensure viewable points are viewable.
stumpwm:*new-window-hook*:
A hook called whenever a window is added
to the window list. This includes a genuinely
new window as well as bringing a withdrawn window
back into the window list.
(Section 15 of the StumpWM manual)
* Commands for marking and removing points,
hiding and revealing, and moving cursor to a point.
* stumpwm:defcommand points-mark.nu
Place a new point for current screen at cursor.
* stumpwm:defcommand points-remove.nu
Remove currently selected point of current screen.
* stumpwm:defcommand points-reveal-toggle.nu
Hide or reveal all points.
* stumpwm:defcommand points-next.nu
Move cursor to next point in sequence.
* stumpwm:defcommand points-prior.nu
Move cursor to prior point in sequence.
* Buttonboard bindings for commands
|#
#|#
Requirements.
This was experienced within:
* stumpwm tiled-view manager
It was a lisp image of SBCL
(Steel Bank Common Lisp 2.1.0).
stumpwm.github.io
sbcl.org
* Common Lisp X Interface (CLX) 0.7.5
The CLX had the XTEST extension (or similar)
for activating the pointer in the Xserver.
github.com/sharplispers/clx
* Xserver
x.org
|#
#|#
The visual shape for a point.
The hot spot for the Xserver cursor must have clearance
when activating a pointer button. A point is drawn
as a white perimeter of a square with a black mask,
made from four Xwindows.
______ _ __ _
| __ | | | |__| | |
| | | | == | | | |
| |__| | | | __ | |
|______| |_| |__| |_|
The left and right sides each have a black background,
and a subwindow with a black background and a white
border as thick as the line for the square perimeter.
For example, the left side (though taller than this):
left
window --> cropped
______ ______
| ____|__ | ____|<-mask
| | | | | |
|b| w _ | |b| w _|<-perimeter
|l| h| | | |l| h| |
|a| i| | | |a| i| |<-black mask
|c| t|_| | |c| t|_|
|k| e | |k| e |
| |_______|subwindow | |____|
|______| |______|
The width of a subwindow is as narrow as the black mask
because its background becomes the right side
of the mask for the square perimeter (white).
The height of a subwindow is short enough for the
top and bottom edges of the window to become the parts
for the black mask.
The subwindow for the left side is offset from the origin
by the intended width of the mask, allowing for the
black background of the window to become the
top, left, and bottom edges for the black mask.
Similarly for the subwindow of the right side.
The top and bottom sides each have a black background,
and a subwindow with a white background as wide
as the sides and as tall as the perimeter height.
top or bottom
window
____________
|____________|<-black mask
|subwindow |<-white perimeter
|____________|
|____________|<-black mask
|#
#|
Hereafter, there be code.
|#
#|#
General function use and naming conventions.
"points": Collective prefix for symbols.
".nu": Arbitrary suffix for preventing name collisions,
as in "named uniquely" or "now unique".
Trace the source of variables by prefixing a letter
representing that source.
defun args prefix: F for "function"
let args prefix: L for "let"
lambda args prefix: A for "anonymous function"
Combine A and L prefixes by depth, thereby revealing scope
and discouraging perplexation. For example:
defun args -> F prefix
defun > let args -> L prefix
defun > let > let > lambda args -> LLA prefix
Favor using the special operator 'multiple-value-call
instead of the macro 'multiple-value-list for results
from Common Lisp funicles returning multiple values.
Consider replacing any funicles returning multiple values
with new funicles returning a list, thereby eliminating
the use of 'multiple-value-call, too.
The stumpwm source tends to have variables and functions
prefixed with an "x" when referring to an instance from
the Common Lisp X Interface library, like an xlib class
or structure. For example: xwin. Do the same.
See also:
* Notes from the documentation for stumpwm and CLX.
|#
#|
Ancillary functions for a foldable list, a.k.a. foldy.
From the independent ancillary funicular foldy functions.
|#
;#
(defun
fold-one.nu
(Ffoldy)
"Move first item of second half to first half.
Moves an item only when cdr is non-nil.
Modifies original, but also returns foldy
as a convenience."
;;Ensure there is an item in second half to move.
(and(cdr Ffoldy)
;;;Move first item of second half to first half.
(push(pop(cdr Ffoldy))(car Ffoldy)))
;;Return foldy as convenience for further use.
Ffoldy)
;#
(defun
fold-all.nu
(Ffoldy)
"Move all items from second half to first half.
Moves an item only when cdr is non-nil.
Modifies original, but also returns foldy
as a convenience."
(do
();no variables
;;;Common Lisp #'do is actually "do until non-nil".
;;; Stop when no more items to move, t.i. cdr is nil.
((not(cdr Ffoldy)))
;;;Move first item of second half to first half.
(push(pop(cdr Ffoldy))(car Ffoldy)))
;;Return foldy as convenience for further use.
Ffoldy)
;#
(defun
unfold-one.nu
(Ffoldy)
"Move first item of first half to second half.
Moves an item only when car is non-nil.
Modifies original, but also returns foldy
as a convenience."
;;Ensure there is an item in first half to move.
(and(car Ffoldy)
;;;Move first item of first half to second half.
(push(pop(car Ffoldy))(cdr Ffoldy)))
;;Return foldy as convenience for further use.
Ffoldy)
;#
(defun
unfold-all.nu
(Ffoldy)
"Move all items from first half to second half.
Moves an item only when car is non-nil.
Modifies original, but also returns foldy
as a convenience."
(do
();no variables
;;;Common Lisp #'do is actually "do until non-nil".
;;; Stop when no more items to move, t.i. car is nil.
((not(car Ffoldy)))
;;;Move first item of first half to second half.
(push(pop(car Ffoldy))(cdr Ffoldy)))
;;Return foldy as convenience for further use.
Ffoldy)
#|#
CLX root Xwindow plist property 'points.nu
A collection of Xserver cursor coordinates
is retained as the 'points.nu property
of the plist of the root Xwindow for a screen.
It is a foldable list for maintaining the current point.
A foldable list (foldy) is simply a cons of two lists.
'(() . ()) == '(() . nil) == '(()) == '(nil)
After the list in the car of the foldy,
each additional item is a cons of coordinates
with Xwindows, t.i. (coordinates . Xwindows).
* Coordinates for the point,
which is itself a cons of x and y.
'(x . y)
* The Xwindows for drawing the point,
which is itself a cons of paired Xwindows,
which each is a cons for each pair.
'((left . right) . (top . bottom))
== '((left . right) top . bottom)
For example, a foldy with its first item
as the current item:
'(
;; car: List for items prior to current item.
()
;; cadr: Current item.
((x1 . y1)
. ((Xwindow-1-left . Xwindow-1-right)
. (Xwindow-1-top . Xwindow-1-bottom)))
;; cddr: The next item and remnants.
((x2 . y2)
. (Xwindows...))
((x3 . y3)
. (Xwindows...))
)
List of points prior to
current selected point: car
Current selected point: cadr
Remnants: cddr
Each point.
Coordinates: car
x: car of car == caar
y: cdr of car == cdar
Xwindows: cdr
left and right: car of cdr == cadr
left: car of cadr
right: cdr of cadr
top and bottom: cdr of cdr == cddr
top: car of cddr
bottom: cdr of cddr
|#
#|#
All functions that directly modify 'points.nu
Initiating:
points-init.nu
Commands:
points-mark.nu
points-remove.nu
points-next.nu
points-prior.nu
|#
;#
(defun
points-init.nu
(Froot)
"Initiate 'points.nu for the screen.
Froot is the root Xwindow of a screen."
;;Remove prior Xwindows for points, when existing.
(and
(getf(xlib:window-plist Froot)'points.nu)
(mapc
(lambda(Apoint)"Destroy Xwindows of point."
(let((ALxwins(cdr Apoint)))
(xlib:destroy-window(caar ALxwins))
(xlib:destroy-window(cdar ALxwins))
(xlib:destroy-window(cadr ALxwins))
(xlib:destroy-window(cddr ALxwins))))
;;;List of points for the screen.
(cdr
(unfold-all.nu
(getf(xlib:window-plist Froot)'points.nu)))))
;;Initiate with an empty foldy.
#|?
Using '(() . ()) or '(nil) with setf
fails to replace former value
unless former value was only ().
Might be to do with #'xlib:window-plist.
Using (cons () ()) succeeds.
?|#
(setf
(getf(xlib:window-plist Froot)'points.nu)
(cons()()))
;;Return 'points.nu for immediate use.
(getf(xlib:window-plist Froot)'points.nu))
;#
(defun
points-drawing.nu
(Fpoint Froot)
"Make drawing instructions for the point for the screen.
Fpoint is a consed pair of coordinates,
t.i. '(x . y)
Froot is the root Xwindow of a screen.
Create the drawing instructions for the point,
but without applying the instructions yet.
Return the set for inclusion as cdr of a point
for the 'points.nu property."
#|
Create four Xwindows centered around the point
and return the consed set.
Full height of square perimeter with mask is 14 pixels.
Width of white perimeter is 2 pixels. Black mask
is one pixel, both inside and outside. Total is: 4.
The white border of a subwindow for left and right sides
is same as the perimeter: 2. The width is one pixel.
The height for a subwindow for left and right sides
is full height of window minus the twice the mask
width, and minus twice the border of the subwindow.
Total: 14 - (2 * 1) - (2 * 2) = 8 pixels.
|#
(let
( ;;;;Each coordinate for point.
(Lx(car Fpoint))
(Ly(cdr Fpoint))
;;;;Function for a vertical side.
(Lvertical-side
(lambda(LAorigin LAsub-origin)
"Create the Xwindow for a vertical side.
LAorigin is a cons of the coordinates
for the origin of the side.
LAsub-origin is a cons of the coordinates
for the origin of its subwindow.
See diagram in the visual shape notes."
(let*
( ;;;;;;;;The vertical side.
(LALvertical-side
(xlib:create-window :parent Froot
:x(car LAorigin)
:y(cdr LAorigin)
:background
(xlib:alloc-color(xlib:window-colormap Froot)"black")
:width 4 :height 14)))
;;;;;;;Add the subwindow to the vertical side.
(xlib:map-window
(xlib:create-window :parent LALvertical-side
:x(car LAsub-origin)
:y(cdr LAsub-origin)
:border
(xlib:alloc-color(xlib:window-colormap Froot)"white")
:border-width 2
:background
(xlib:alloc-color(xlib:window-colormap Froot)"black")
:width 1 :height 8))
;;;;;;;Return the vertical side.
LALvertical-side)))
;;;;Function for a horizontal side.
(Lhorizontal-side
(lambda(LAorigin)
"Create the Xwindow for a horizontal side.
LAorigin is a cons of the coordinates
for the origin of the side.
See diagram in the visual shape notes."
(let*
( ;;;;;;;;The horizontal side.
(LALhorizontal-side
(xlib:create-window :parent Froot
:x(car LAorigin)
:y(cdr LAorigin)
:background
(xlib:alloc-color(xlib:window-colormap Froot)"black")
:width 6 :height 4)))
;;;;;;;Add the subwindow to the horizontal side.
(xlib:map-window
(xlib:create-window :parent LALhorizontal-side
:x 0 :y 1
:background
(xlib:alloc-color(xlib:window-colormap Froot)"white")
:width 6 :height 2))
;;;;;;;Return the vertical side.
LALhorizontal-side))))
;;;Create the sides, pair them together,
;;; and return the set.
(cons
;;;;Left and right sides
(cons
;;;;;Left side.
(funcall Lvertical-side
(cons(- Lx 7)(- Ly 7))(cons 1 1))
;;;;;Right side.
(funcall Lvertical-side
(cons(+ Lx 3)(- Ly 7))(cons -2 1)))
;;;;Top and bottom sides.
(cons
;;;;;Top side.
(funcall Lhorizontal-side(cons(- Lx 3)(- Ly 7)))
;;;;;Bottom side.
(funcall Lhorizontal-side(cons(- Lx 3)(+ Ly 3)))))))
#|
Complementary functions.
These isolate instructions particular to 'points.nu
and were consistently repeated in other functions.
Intended for use in functions in only this document.
Remove any that are used only once.
Movement of the Xserver cursor is separated from drawing
the points in order to respect purposefully hiding them.
Prioritizing has no affect on viewability, but does
ensure visibility for mapped Xwindows, therefore
it is safe to prioritize unmapped Xwindows.
Determining viewability is shared by many tasks,
such as marking a point, removing a point,
and toggling the hiding and revealing of all points.
|#
;#
(defun
points-viewablep.nu
();no options
"Determine whether points are viewable.
This test is for determining purposefully viewable
or hidden points, t.i. mapped or unmapped by
the #'points-reveal-toggle.nu command.
The Xserver declares the word viewable to mean mapped.
Points might remain unseen when they have less priority."
(and
;;;Ensure there is a current point...
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu))
;;;...and that its shape is viewable.
(eq :viewable
#|
An Xwindow of the current point.
Specifically the left part [caar]
from the set of Xwindows [cdr]
for current point [cadr]
from all points for screen [getf].
|#
(xlib:window-map-state
(caar
(cdr
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu))))))))
;#
(defun
points-prioritize.nu
();no options
"Highest priority for all points.
Re-prioritize order of all points
without changing viewability."
;;Nothing to do unless current point exists.
(when
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu))
(let*
( ;;;;The root Xwindow of current screen.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;All points for current screen.
(Lpoints
(getf(xlib:window-plist Lroot)'points.nu))
;;;;Function for prioritizing the Xwindows of a point.
(Lprioritize-xwins
(lambda(LApoint)
"Highest priority for all the Xwindows of point."
(let
( ;;;;;;;;Xwindows for the point.
(LALxwins(cdr LApoint)))
(setf
(xlib:window-priority(caar LALxwins)):above
(xlib:window-priority(cdar LALxwins)):above
(xlib:window-priority(cadr LALxwins)):above
(xlib:window-priority(cddr LALxwins)):above)))))
;;;Update priority of prior points.
;;; Reversed so most immediate prior point
;;; is prioritized more than others.
(mapc Lprioritize-xwins(reverse(car Lpoints)))
;;;Update priority of later points, then current point.
;;; Reversed so most immediate next point
;;; is prioritized more than others,
;;; and current point prioritized more than all.
(mapc Lprioritize-xwins(reverse(cdr Lpoints))))))
;#
(defun
points-draw.nu
();no options
"Draw the collected points of current screen.
Points are prioritized from current point outward,
t.i. current, next/prior, next-after/prior-after,
and so on."
;;Draw all points and prioritize current point.
(let*
( ;;;;The root Xwindow for current screen.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;Function for prioritizing and drawing.
(Lprioritize-draw-xwins
(lambda(LApoint)"Prioritize and map point."
(let((LALxwins(cdr LApoint)))
(setf
(xlib:window-priority(caar LALxwins)):above
(xlib:window-priority(cdar LALxwins)):above
(xlib:window-priority(cadr LALxwins)):above
(xlib:window-priority(cddr LALxwins)):above)
(xlib:map-window(caar LALxwins))
(xlib:map-window(cdar LALxwins))
(xlib:map-window(cadr LALxwins))
(xlib:map-window(cddr LALxwins))))))
;;;Points prior to current point.
;;; Reversed so most immediate prior point
;;; is prioritized more than others.
(mapc Lprioritize-draw-xwins
(reverse
(car(getf(xlib:window-plist Lroot)'points.nu))))
;;;Current and later points.
;;; Reversed so most immediate next point
;;; is prioritized more than others,
;;; and current point prioritized more than all.
(mapc Lprioritize-draw-xwins
(reverse
(cdr(getf(xlib:window-plist Lroot)'points.nu))))))
;#
(defun
points-move-cursor.nu
();no options
"Move Xserver cursor to current point.
Re-prioritize order of all points
without changing viewability."
;;Nothing to do unless current point exists.
(when
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu))
(let*
( ;;;;The root Xwindow of current screen.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;Coordinates [car] for current point [cadr].
(Lxy
(car
(cadr(getf(xlib:window-plist Lroot)'points.nu)))))
;;;Move cursor to current point.
(xlib:warp-pointer Lroot(car Lxy)(cdr Lxy))
;;;Prioritize all points just in case they are viewable.
(points-prioritize.nu))))
#|
Functions for StumpWM hooks.
|#
;#
(defun
points-new-window-hook.nu
#|?
Mystery option, undocumented in manual.
Research the StumpWM source code
for *new-window-hook*.
Okay for now as there is no need for it.
?|#
(Fwhats-the-fantasy-for-this?)
"Ensure viewable points are viewable.
Starting a program might create a new Xwindow
with higher priority than the points. The points
are technically still :viewable even when obscured.
Make points have highest priority after any window
has been given highest priority.
Prioritized without mapping, thereby respecting
purposeful hiding of points.
Intended for 'stumpwm:new-window-hook."
;;Prioritize all points, but without mapping
;; just in case they were purposefully hidden.
(points-prioritize.nu))
;Add hook for 'stumpwm:*new-window-hook*.
; Note the StumpWM manual has an error
; in one of its examples about add-hook.
; Be sure to use no ' before its own hook names.
(stumpwm:add-hook stumpwm:*new-window-hook*
'points-new-window-hook.nu)
#|
Commands for marking and removing points,
hiding and revealing, and moving cursor to a point.
|#
;#
(stumpwm:defcommand
points-mark.nu
();no options
();no prompt
"Place a new point for current screen at cursor.
Use the cursor coordinates for a new point
of current screen. The new point becomes
the selected point.
Mark a new point only when points are shown,
or when there are no other points.
See #'points-reveal-toggle.nu for revealing points."
#|
Draw a shape at the coordinates of the Xserver cursor.
Store coordinates and its shape in 'points.nu
of the root Xwindow for the current screen.
Irrelevant when there is already a point,
t.i. no movement of cursor, no change of selection.
Also the points must be viewable rather than hidden.
Otherwise, this command is ignored.
|#
(when
;;;Mark a point only when points are already visible,
;;; or no existing points.
(let
( ;;;;;All points, if any, for current screen.
(Lpoints
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu)))
(or
;;;;;Either there is no 'points.nu for screen...
(not Lpoints)
;;;;; ...or there are no points...
(equal'(() . ())Lpoints)
;;;;; ...or the points are viewable.
(points-viewablep.nu)))
;;;Confirm cursor coordinates are a new point.
(let*
( ;;;;;The root Xwindow for current screen.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;;Coordinates of current point.
;;;;; Remove extra info later.
(Lpoint
(multiple-value-call'list
(xlib:global-pointer-position stumpwm:*display*)))
;;;;;The current points for testing. Initiate as needed.
(Lpoints
(or
(getf(xlib:window-plist Lroot)'points.nu)
(points-init.nu Lroot)))
;;;;;Function for comparing coordinates of points.
(Lequal-point
(lambda(LApoint LApoint-xwin)
"Compare point with coordinates of point-xwin data.
Point is a cons of x and y.
Point-xwin is a cons of a point and an Xwindow.
Return t when coordinates are same."
;;;;;;;#'equal compares list items, like in a cons.
(equal LApoint(car LApoint-xwin)))))
;;;;Determine current cursor point, ignore extra info.
(setq Lpoint(cons(car Lpoint)(cadr Lpoint)))
;;;;Add point only when non-existing.
(unless
(or
;;;;;;Test prior points.
(member Lpoint(car Lpoints):test Lequal-point)
;;;;;;Test current point and later points.
(member Lpoint(cdr Lpoints):test Lequal-point))
;;;;;Make the current point the prior point.
(fold-one.nu
(getf(xlib:window-plist Lroot)'points.nu))
;;;;;Add new point as the currently selected point.
(push
(cons Lpoint(points-drawing.nu Lpoint Lroot))
(cdr
(getf(xlib:window-plist Lroot)'points.nu)))
;;;;;Draw the point.
(points-draw.nu)))))
;#
(stumpwm:defcommand
points-remove.nu
();no options
();no prompt
"Remove currently selected point of current screen.
Make next point in sequence the current point
and move the cursor to it.
Remove the point only when points are shown.
See #'points-reveal-toggle for revealing points."
(let*
( ;;;;The root Xwindow for current screen.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;The Xwindows [cdr] of current point [cadr], or nil.
(Lxwins
(cdr(cadr(getf(xlib:window-plist Lroot)'points.nu)))))
;;;Remove current point only when points are viewable.
(when(points-viewablep.nu)
;;;;Destroy the Xwindows for current point.
(xlib:destroy-window(caar Lxwins))
(xlib:destroy-window(cdar Lxwins))
(xlib:destroy-window(cadr Lxwins))
(xlib:destroy-window(cddr Lxwins))
;;;;Remove current point [car of cdr] from the list.
(pop(cdr(getf(xlib:window-plist Lroot)'points.nu)))
;;;;Ensure there is still a current point.
(and
;;;;;There is no current point,
;;;;; and no later points...
(not
(cdr(getf(xlib:window-plist Lroot)'points.nu)))
;;;;; ...and there are prior points.
(car(getf(xlib:window-plist Lroot)'points.nu))
;;;;;So, make the prior point the current point.
(unfold-one.nu
(getf(xlib:window-plist Lroot)'points.nu)))
;;;;Move cursor to current point, when any.
(points-move-cursor.nu))))
;#
(stumpwm:defcommand
points-reveal-toggle.nu
();no options
();no prompt
"Hide or reveal all points.
Move cursor to current point when revealed."
#|
Determine whether points are viewable
by simply testing current point.
|#
;;Nothing to do when no points.
(when
;;;Test for current point.
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu))
;;;Points do exist.
(let*
( ;;;;;The points for current screen.
(Lpoints
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu)))
;;;;Determine whether points are viewable.
(if(points-viewablep.nu)
;;;;;Hide the points.
;+++;Could extract as a command, but no interest.
;+++; Toggle fits comfortably with overall experience.
(let
( ;;;;;;;Function for hiding a point.
(LLhide-xwins
(lambda(LLApoint)"Hide point."
(let((LLALxwins(cdr LLApoint)))
(xlib:unmap-window(caar LLALxwins))
(xlib:unmap-window(cdar LLALxwins))
(xlib:unmap-window(cadr LLALxwins))
(xlib:unmap-window(cddr LLALxwins))))))
;;;;;;Hide the prior points.
(mapc LLhide-xwins(car Lpoints))
;;;;;;Hide the current point and later points.
(mapc LLhide-xwins(cdr Lpoints)))
;;;;;Otherwise, reveal points and place cursor.
(progn
(points-draw.nu)
(points-move-cursor.nu))))))
;#
(stumpwm:defcommand
points-next.nu
();no options
();no prompt
"Move cursor to next point in sequence."
;;Nothing to do when no points.
(when
;;;Test for current point.
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu))
;;;Maybe fold to next item,
;;; or maybe wrap to beginning.
(let*
( ;;;;;The root window.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;;The points.
(Lpoints
(getf(xlib:window-plist Lroot)'points.nu)))
(cond
( ;;;;;When next item exists...
(cddr Lpoints)
;;;;;...fold to it.
(fold-one.nu
(getf(xlib:window-plist Lroot)'points.nu)))
( ;;;;;Otherwise, when prior items exist...
(car Lpoints)
;;;;;...unfold all.
(unfold-all.nu
(getf(xlib:window-plist Lroot)'points.nu))))
;;;;Move cursor to current point, even when no change.
(points-move-cursor.nu))))
;#
(stumpwm:defcommand
points-prior.nu
();no options
();no prompt
"Move cursor to prior point in sequence."
;;Nothing to do when no points.
(when
;;;Test for current point.
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu))
;;;Maybe unfold to prior item,
;;; or maybe wrap to beginning.
(let*
( ;;;;;The root window.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;;The points.
(Lpoints
(getf(xlib:window-plist Lroot)'points.nu)))
(cond
( ;;;;;When prior item exists...
(car Lpoints)
;;;;;...unfold to it.
(unfold-one.nu
(getf(xlib:window-plist Lroot)'points.nu)))
( ;;;;;Otherwise, when next items exist...
(cddr Lpoints)
;;;;;...fold to final item.
(unfold-one.nu
(fold-all.nu
(getf(xlib:window-plist Lroot)'points.nu)))))
;;;;Move cursor to current point, even when no change.
(points-move-cursor.nu))))
#|#
Bindings are for the numeric pad.
Consider coordinating with commands
for pointer button activation.
Use the #'stumpwm:describe-key command
to discover the names of the buttons.
Default keybinding for it is Control-t h k,
as revealed with help (Control-t ?).
For whatever reason, the numbers were available
with the Shift button, f.e. Shift-7 is "KP_7"
and 7 is "KP_Home".
c = / *
7 8 9 - M R
4 5 6 + => P 1 N T
1 2 3 enter 1t 3
_0_ . enter
"0" is "M" is "points-mark".
double-wide. "R" is "points-remove".
"enter" is "P" is "points-previous".
double-tall. "N" is "points-next".
"c" is "clear", "T" is "points-reveal-toggle".
but is Num_Lock. "1" activates primary button.
"1t" toggles primary button.
"3" is the secondary button.
See also:
* Numeric pad layout for a buttonboard.
|#
;Mark a point at cursor position.
(stumpwm:define-key stumpwm:*top-map*
(stumpwm:kbd"KP_7")"points-mark.nu")
;Next point in series.
(stumpwm:define-key stumpwm:*top-map*
(stumpwm:kbd"KP_6")"points-next.nu")
;Prior point in series.
(stumpwm:define-key stumpwm:*top-map*
(stumpwm:kbd"KP_4")"points-prior.nu")
;Hide or reveal the points.
(stumpwm:define-key stumpwm:*top-map*
(stumpwm:kbd"S-KP_Add")"points-reveal-toggle.nu")
;Remove currently selected point.
(stumpwm:define-key stumpwm:*top-map*
(stumpwm:kbd"KP_8")"points-remove.nu")
#|
Quick reload for trying out new changes.
Consider editing a copy.
|#
#|
(stumpwm:defcommand
reload.points
();no options
();no prompt
"Reload points.lisp.html document."
#|
The #'stumpwm:message function uses the Common Lisp
#'format function (CLHS 22.4).
The ~s is for printing an object, like quoted text.
See section 22.3.11 Examples of format (CLHS) for more.
|#
(let
( ;;;;Be sure to change path or document name
;;;; after making a new copy, when needed.
(Ldoc
"~/.stumpwm.d/custom/points.lisp.html"))
;;Load the lisp document.
(load Ldoc)
;;Provide a message as confirmation.
(stumpwm:message
"Loaded:
~s"
Ldoc)))
;Bind load command for quick reload.
(stumpwm:define-key stumpwm:*top-map*
(stumpwm:kbd"F19")"reload.points")
|#