#|
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.
Write a list of marked points to a document,
then later read and apply that list of points
to restore them for use again.
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.
The #'points-write.nu command prompts for a document name
and writes a foldy of the points to that document.
Either add a buttonboard binding for the command,
or use Control-t ; from StumpWM to type the command.
The #'points-read.nu command prompts for a document name
and reads a foldy of points from that document.
It then removes all points currently marked,
applies the new points, and moves the cursor
to the current point for that foldy.
Either add a buttonboard binding for the command,
or use Control-t ; from StumpWM to type the command.
|#
#|
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.
* Commands for writing and reading points
for current screen, for later use.
* stumpwm:defcommand points-write.nu
Write all coordinates from 'points.nu to a document.
* stumpwm:defcommand points-read.nu
Replace coordinates for 'points.nu from a document.
* 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
points-read.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 existing Xwindows of point."
(let((ALxwins(cdr Apoint)))
(when ALxwins
(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."
(let
( ;;;;The Xwindows [cdr]
;;;; of the current point [cadr]
;;;; of all points of current screen [getf].
(Lcurrent-point-xwins
(cdr
(cadr
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu)))))
(and
;;;;Ensure the Xwindows of current point exist...
Lcurrent-point-xwins
;;;...and that its Xwindows are viewable.
(eq :viewable
;;;;Just the left part [caar] for current point.
(xlib:window-map-state
(caar Lcurrent-point-xwins))))))
;#
(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 the Xwindows of point."
(let
( ;;;;;;;;Xwindows for the point,
;;;;;;;; or nil when non-existent.
(LALxwins(cdr LApoint)))
(and LALxwins
(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."
;;;;;;Point already has instructions for drawing [cdr],
;;;;;; or set them.
(or(cdr LApoint)
(setf(cdr LApoint)
(points-drawing.nu
(car LApoint)
(stumpwm:screen-root(stumpwm:current-screen)))))
(let
( ;;;;;;;;The Xwindows for 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)
(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))))
#|
Commands for writing and reading points
for current screen, for later use.
For use with the #'stumpwm:colon command
available by default within StumpWM
as Control-t ; (yes, a semicolon).
|#
;#
(stumpwm:defcommand
points-write.nu
(Fwrite-to-doc)
((:string
"Write all points of current screen
to document: "))
"Write all coordinates from 'points.nu to a document.
Write a foldy of the points for the current screen
to the specified document.
Fwrite-to-doc is text for a path (t.i. directories)
and a document name.
For example, save to a document named a-doc
of the /tmp/ directory:
/tmp/a-doc
For whatever reason, the login directory
can be abbreviated to just a ~. That means:
/home/account-name/.stumpwm.d/custom/another-doc
can be represented as:
~/.stumpwm.d/custom/another-doc
Path must already exist. Document is created
when non-existent. Append, no overwrite.
The coordinates of all points for current screen
are gathered. No Xwindows because they can be
recreated, so the value reduces to a foldy
of only coordinates.
For example, a foldy that has yet to be folded:
(NIL
(x1 . y1)
(x2 . y2)
; and so forth...
)
A folded list remains folded, wherewith the point
current at time of writing the value is maintained.
Supplementary to the #'points-read.nu command."
#|
This is just a basic convenience function
that simply writes the value of a variable
to a document. Basicly:
; Safely open/close the specified document.
(with-open-file
(the-stream-name the-doc-path
:direction :output
:if-does-not-exist :create
:if-exists :append)
;; Format the text for writing into document,
;; t.i. into the "stream of text" for it.
(format the-stream-name
;;; A couple of blank lines within the double quotes.
;;; The ~s is the placeholder for the object, f.e. list.
"
~s"
;;; Then do whatever is needed for creating the object.
...))
|#
#|+
Consider the #'ensure-directories-exist function (CLHS)
for creating any nonexisting directories of path.
For now, directories must exist.
+|#
(cond
( ;;;;Ensure directories already exist, without creating.
(not
(probe-file
(directory-namestring Fwrite-to-doc)))
(stumpwm:message
"Nonexistent directory: ~s
No access to document."
(directory-namestring Fwrite-to-doc)))
( ;;;;Otherwise, attempt to write to file.
t
(with-open-file
;;;;;Name temporary stream for doc as WOFwrite-to-doc.
;;;;; Then specify some options for opening.
(WOFwrite-to-doc Fwrite-to-doc
;;;;;;Only write to the doc, no need for reading.
:direction :output
;;;;;;Create when non-existent.
;;;;;; Append rather than overwrite.
:if-does-not-exist :create
:if-exists :append)
;;;;;Write only the coordinates of the points,
;;;;; No need for the Xwindows, they can be recreated.
(format WOFwrite-to-doc
;;;;;;Recall ~% is a newline for the #'format function,
;;;;;; but a newline within the double quotes works, too.
;;;;;; The ~s is a placeholder for an object,
;;;;;; t.i. the list of coordinates.
"
~s"
(let
( ;;;;;;;;The points for only the current screen.
(Lpoints-foldy
(getf
(xlib:window-plist
(stumpwm:screen-root(stumpwm:current-screen)))
'points.nu)))
;;;;;;;Two halves for the 'points.nu foldable list.
(cons
(and
;;;;;;;;;Nil is an empty list, so just return it as is.
(car Lpoints-foldy)
;;;;;;;;;Otherwise, create a new list [mapcar]
;;;;;;;;; with the coordinates of each point ['car]
;;;;;;;;; from the list in first half of foldy [car].
(mapcar'car(car Lpoints-foldy)))
(and
;;;;;;;;;Similarly for second half of foldy [cdr].
(cdr Lpoints-foldy)
(mapcar'car(cdr Lpoints-foldy))))))
;;;Provide a message as confirmation.
(stumpwm:message
"Appended points to:
~s"
Fwrite-to-doc)))))
;#
(stumpwm:defcommand
points-read.nu
(Fread-from-doc)
((:string
"Remove points from current screen
and mark new points from document: "))
"Replace points for 'points.nu from a document.
Read a foldy of coordinates from the specified document.
Remove all points marked for current screen,
mark the new points, then move the Xserver cursor
to the current point from that foldy.
Fread-from-doc is text for a path (t.i. directories)
and a document name.
For example, save to a document named a-doc
of the /tmp/ directory:
/tmp/a-doc
For whatever reason, the login directory
can be abbreviated to just a ~. That means:
/home/account-name/.stumpwm.d/custom/another-doc
can be represented as:
~/.stumpwm.d/custom/another-doc
Supplementary to the #'points-write.nu command."
#|
When editing the points in a document
to be read and applied by this command,
note the points are without their Xwindows,
but are still in a foldable list.
The Xwindows will be recreated when needed.
Review the description of points.nu property
to compare the differences.
Recall:
* A foldy begins as a pair of lists: (() . ())
* () is the same as NIL
* A "proper" list is just an abbreviation
for the same list consed with NIL.
(item) == (item . nil) == (item . ())
(()) == (() . NIL) == (() . ())
For example, consider when everything
is in the second half of the foldy.
(NIL
(100 . 100) (200 . 100) (300 . 100) (400 . 100))
Or, some points are in the first half of the foldy:
(((100 . 100) (200 . 100))
(300 . 100) (400 . 100))
Or, everything is in the first half of the foldy:
(((100 . 100) (200 . 100) (300 . 100) (400 . 100)))
Otherwise, consider writing the current list of points
with the #'points-write.nu command.
|#
(cond
( ;;;;Nothing to do when no path, t.i. when NIL.
(not Fread-from-doc)
(stumpwm:message
"No document name given, or command was canceled."))
( ;;;;Document needs to exist.
(not(probe-file Fread-from-doc))
(stumpwm:message
"No existing document: ~s"
Fread-from-doc))
( ;;;;Otherwise, attempt to load value from document.
t
(let
( ;;;;;;The root Xwindow for current screen.
(Lroot
(stumpwm:screen-root(stumpwm:current-screen)))
;;;;;;Read first parenthesized form from document.
(Lnew-value
(with-open-file
(WOFread-from-doc Fread-from-doc
;;;;;;Only read from the doc, no need for writing.
:direction :input)
(read WOFread-from-doc))))
;;;;;Properly initiate 'points.nu property.
(points-init.nu Lroot)
;;;;;Replace the points in 'points.nu for current screen.
(setf
(getf(xlib:window-plist Lroot)'points.nu)
;;;;;;Prepare the points in the foldy by making
;;;;;; a list with each point, for each half.
(cons
(and
;;;;;;;;NIL is an empty list, so just return it as is.
(car Lnew-value)
;;;;;;;;Otherwise, create a new list [mapcar]
;;;;;;;; by putting each point in its own list ['list]
;;;;;;;; from the list in first half of foldy [car].
(mapcar'list(car Lnew-value)))
(and
;;;;;;;;Similarly for second half of foldy.
(cdr Lnew-value)
(mapcar'list(cdr Lnew-value))))))
;;;;Display points for confirming success.
(points-draw.nu)
(points-move-cursor.nu)
(stumpwm:message
"Read and applied points from:
~s"
Fread-from-doc))))
#|#
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-later.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-later.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")
|#