luv

Workshop wiki

command-menu.lisp

mcclim/command-menu.lisp

system luv/mcclim · 55 definitions · on GitHub

in-package#:mcluv

M-x is an application instrument, not a game feature. It reads an application's existing command tables, retains one searchable snapshot, and executes the selected command on the frame which owns that vocabulary. Nothing in this file knows about a luvcraft session or a luft viewer.

defconstant+command-menu-width+620
defconstant+command-menu-height+420
defuncommand-menu-alpha-ink
redgreenbluealpha
compose-in
make-rgb-colorredgreenblue
make-opacityalpha

Uniform translucent inks remain uniform composita in McCLIM. The direct compositor carries their alpha with the semantic primitive and premultiplies rgb in its vertex shader before blending over the game.

defparameter*command-menu-panel-ink*
command-menu-alpha-ink0.0550.0600.0560.92
defparameter*command-menu-field-ink*
command-menu-alpha-ink0.0180.0210.0190.78
defparameter*command-menu-text-ink*
make-rgb-color0.930.920.87
defparameter*command-menu-muted-ink*
make-rgb-color0.640.660.61
defparameter*command-menu-selected-text-ink*
make-rgb-color0.0550.0650.055
define-conditioncommand-menu-requires-direct-gpu
error
object:initarg:object:readercommand-menu-non-gpu-object
:report
lambda
conditionstream
formatstream"M-x requires retained direct GPU McCLIM media, not ~S."
command-menu-non-gpu-objectcondition
define-conditioncommand-menu-direct-presentation-violation
error
reason:initarg:reason:readercommand-menu-presentation-violation-reason
:report
lambda
conditionstream
formatstream"M-x violated its direct presentation contract: ~A."
command-menu-presentation-violation-reasoncondition
defclasscommand-menu-entry
label:initarg:label:readercommand-menu-entry-label
command-name:initarg:command-name:readercommand-menu-entry-command-name
table:initarg:table:readercommand-menu-entry-table
:documentation

One cached, executable command-table entry displayed by M-x.

defmethodprint-object
print-unreadable-object
entrystream:typet
formatstream"~A -> ~S"
command-menu-entry-labelentry
command-menu-entry-command-nameentry
defgenericcommand-menu-tables-for
owner-frame
:documentation

Return the command tables whose executable vocabulary M-x shows.

The default is owner-frame's complete table. Applications may either pass an explicit list to make-embedded-command-menu or specialize this protocol when their semantic layers should remain separately inspectable.

defmethodcommand-menu-tables-for
owner-framestandard-application-frame
list
frame-command-tableowner-frame
defuncommand-menu-command-without-required-arguments-p
name

Whether name is a command M-x can execute without prompting yet.

alexandria:when-let
parsers
gethashnameclimi::*command-parser-table*
null
climi::required-argsparsers
defuncommand-menu-entries-for-tables
tables&keyowner-frame
inheritednil

Return cached M-x entries read from tables.

Each command appears once even when command-table inheritance exposes it in several layers. owner-frame, when supplied, excludes commands which that application currently disables. Commands with required arguments remain out until M-x has an argument-prompting interaction instead of becoming dead rows.

let
entriesnil
seen
make-hash-table:test#'eq
dolist
tabletables
map-over-command-table-commands
lambda
name
unless
gethashnameseen
setf
gethashnameseen
t
alexandria:when-let
label
command-line-name-for-commandnametable:errorpnil
when
and
or
nullowner-frame
command-enablednameowner-frame
push
make-instance'command-menu-entry:labellabel:command-namename:tabletable
entries
table:inheritedinherited
sortentries#'string-lessp:key#'command-menu-entry-label
defunmatching-command-menu-entries
entriesquery&key
key#'command-menu-entry-label

Return entries whose labels contain every whitespace-separated query word.

let
words
remove-if#'alexandria:emptyp
uiop:split-stringquery:separator'
#\Space#\Tab
if
nullwords
entries
remove-if-not
lambda
entry
let
label
funcallkeyentry
every
lambda
word
searchwordlabel:test#'char-equal
words
entries
define-application-framecommand-menu
owner-frame:initarg:owner-frame:readercommand-menu-owner-frame
command-tables:initarg:command-tables:initformnil:accessorcommand-menu-command-tables
inherited-p:initarg:inherited:initformnil:accessorcommand-menu-inherited-p

Command discovery happens explicitly at construction or refresh time. Repaint reads only these cached rows and never invokes application code.

entries:initformnil:accessorcommand-menu-entries
results:initformnil:accessorcommand-menu-results
query:initform"":accessorcommand-menu-query
selected:initform0:accessorcommand-menu-selected
dirty-p:initformt:accessorcommand-menu-dirty-p
:menu-barnil
:panes
sheet

A one-pane overlay has no layout job. Making SHEET the layout also keeps an HRACK-PANE (and its opaque McCLIM background) out of the retained GPU stream, including the rounded panel's transparent corner samples.

:layouts
defaultsheet
defunupdate-command-menu-results
frame&keyreset-selection-p

Synchronously filter frame's cached entries without repainting it.

setf
command-menu-resultsframe
matching-command-menu-entries
command-menu-entriesframe
command-menu-queryframe
whenreset-selection-p
setf
command-menu-selectedframe
0
frame
defunrefresh-command-menu-entries

Re-read frame's application vocabulary outside its repaint method.

setf
command-menu-entriesframe
command-menu-entries-for-tables
command-menu-command-tablesframe
:owner-frame
command-menu-owner-frameframe
:inherited
command-menu-inherited-pframe
command-menu-dirty-pframe
t
defmethodinitialize-instance:after
unless
command-menu-command-tablesframe
setf
command-menu-command-tablesframe
command-menu-tables-for
command-menu-owner-frameframe
command-menu-inherited-pframe
t
defuncommand-menu-visible-results

Return frame's visible result window and its zero-based start index.

let*
results
command-menu-resultsframe
count
lengthresults
selected
if
pluspcount
mod
command-menu-selectedframe
count
0
values
subseqresultsstart
start
defuncommand-menu-selected-command

Return frame's selected argument-free command form, or NIL.

let
results
command-menu-resultsframe
whenresults
list
command-menu-entry-command-name
nth
mod
command-menu-selectedframe
lengthresults
results
defunensure-command-menu-gpu-medium
medium
unless
typepmedium'luv-gpu-medium
medium
defmethodhandle-repaint
declare
ignoreregion
let*
frame
pane-framepane
query
command-menu-queryframe
results
command-menu-resultsframe
selected
command-menu-selectedframe
with-bounding-rectangle*
lefttopright-edgebottom
pane
with-sheet-medium
mediumpane

Every surface is an analytic primitive. Layered filled roundrects provide borders without invoking McCLIM's decomposed outline path.

draw-analytic-rounded-rectangle*medium
+left7
+top9
-right-edge1
-bottom1
:radius18:ink*command-menu-shadow-ink*
draw-analytic-rounded-rectangle*mediumlefttopright-edgebottom:radius18:ink*command-menu-edge-ink*
draw-analytic-rounded-rectangle*medium
+left2
+top2
-right-edge2
-bottom2
:radius16:ink*command-menu-panel-ink*
draw-text*pane"M-x"margin30:align-y:center:text-size22:text-face:bold:ink*command-menu-text-ink*
draw-text*pane"Esc cancels"right30:align-x:right:align-y:center:text-size14:ink*command-menu-muted-ink*
let*
prompt"M-x "
text
concatenate'stringpromptquery
text-x
+margin12
width
text-sizepanetext:text-style
make-text-stylenilnil18
draw-text*panetexttext-xtext-y:align-y:center:text-size18:ink*command-menu-text-ink*
draw-rectangle*pane
+text-xwidth2
-text-y11
+text-xwidth4
+text-y11
:ink*command-menu-field-edge-ink*
multiple-value-bind
visiblestart
loopforentryinvisibleforindexfromstartforyfrom+command-menu-results-top+by+command-menu-row-height+do
draw-command-menu-rowpaneentryy
=indexselected
when
nullresults
draw-text*pane"No matching command"margin:align-y:center:text-size16:ink*command-menu-muted-ink*
draw-text*pane
formatnil"~D command~:P · ↑↓ choose · RET runs"
lengthresults
margin:align-y:center:text-size14:ink*command-menu-muted-ink*
defuncommand-menu-mirror
frame&key
errorpt

Return frame's embedded direct-GPU mirror.

let*
sheet
frame-top-level-sheetframe
mirror
andsheet
sheet-direct-mirrorsheet
cond
typepmirror'luv-gpu-mirror
mirror
errorp
tnil
defunvalidate-command-menu-direct-presentation

Assert frame contains analytic/text GPU media and no rasterized image path.

let*
sheet
mirror-sheetmirror
when
mirror-texturemirror
error'command-menu-direct-presentation-violation:reason"the embedded mirror acquired a backing texture"
dolist
painted-sheet
let
when
error'command-menu-direct-presentation-violation:reason
formatnil"~S used decomposed primitive fallbacks"painted-sheet
when
find-if
lambda
command
error'command-menu-direct-presentation-violation:reason"a rasterized image command reached the prepared stream"
frame
defunrepaint-command-menu

Synchronously rebuild and publish frame's retained semantic GPU stream.

An embedded GPU mirror performs no drawable acquisition, command submission, readback, or GPU wait here. It snapshots and uploads the complete semantic revision for replay by the owning application's next presentation pass.

alexandria:when-let
mirror
unless
mirror-embedded-pmirror
setf
command-menu-dirty-pframe
nil
frame
defuninvalidate-command-menu

Mark frame changed and synchronously repaint it when it is realized.

setf
command-menu-dirty-pframe
t
defunprepare-command-menu

Ensure frame has a complete retained revision for direct composition.

let
if
or
command-menu-dirty-pframe

Static semantic media must still observe live shader revisions.

frame
defuncommand-menu-panel-scale
viewport-extent
destructuring-bind
viewport-widthviewport-height
viewport-extent
defuncommand-menu-screen-state
frameviewport-logical-extent

Return a centered affine state measured in destination logical pixels.

At scale one, one command-menu coordinate occupies one logical pixel in the game viewport. The final direct render therefore receives the destination's native pixel density automatically: a 2x drawable evaluates every analytic edge and Slug glyph at twice the samples without a raster upscale.

declare
ignoreframe
destructuring-bind
viewport-widthviewport-height
viewport-logical-extent
let*
scale
command-menu-panel-scaleviewport-logical-extent
half-width
half-height
make-array12:element-type'single-float:initial-contents
mapcar
lambda
value
coercevalue'single-float
list0.00.00.01.0half-width0.00.00.00.0half-height0.00.0
defuncommand-menu-local-coordinate
framepointer-xpointer-yviewport-logical-extent

Map a destination-logical pointer to frame coordinates, or return NIL.

declare
ignoreframe
destructuring-bind
viewport-widthviewport-height
viewport-logical-extent
let*
scale
command-menu-panel-scaleviewport-logical-extent
left
*0.5
-viewport-widthdisplay-width
top
*0.5
-viewport-heightdisplay-height
when
and
<=leftpointer-x
+leftdisplay-width
<=toppointer-y
+topdisplay-height
values
/
-pointer-xleft
scale
/
-pointer-ytop
scale
defunmove-command-menu-selection
framedelta
let
count
length
command-menu-resultsframe
when
pluspcount
setf
command-menu-selectedframe
mod
+
command-menu-selectedframe
delta
count
frame
defunhandle-command-menu-key-event
frameevent

Handle one portable key press and return action and optional COMMAND.

action is :CONTINUE, :DISMISS, or :EXECUTE. This function never calls the application command while it is updating or repainting M-x; the host dismisses its modal surface first and passes COMMAND to execute-command-menu-command.

when
luv:canvas-key-event-repeat-pevent
return-fromhandle-command-menu-key-event
values:continuenil
let
key
luv:canvas-key-event-key-nameevent
character
luv:canvas-key-event-characterevent
casekey
:escape
values:dismissnil
:return:keypad-enter
:up
values:continuenil
:down
values:continuenil
:backspace
let
query
command-menu-queryframe
when
plusp
lengthquery
values:continuenil
t
when
andcharacter
graphic-char-pcharacter
null
intersection'
:control:meta:super
luv:canvas-key-event-modifiersevent
edit-command-menu-queryframe
concatenate'string
command-menu-queryframe
stringcharacter
values:continuenil
defunhandle-command-menu-pointer-press
framexybutton

Select the result row at local X,Y and return action and COMMAND.

values:continuenil
defunexecute-command-menu-command
framecommand&keybefore-execute

Execute command on frame's owner, after optional before-execute.

The owner is captured first so before-execute may destroy frame while removing the modal surface. Application commands therefore never run underneath M-x.

whencommand
let
owner
command-menu-owner-frameframe
whenbefore-execute
funcallbefore-execute
execute-frame-commandownercommand
defunmake-embedded-command-menu
owner-framecanvascontextdevice&keycommand-tables
inherited
nullcommand-tables
title"M-x"

Create owner-frame's retained direct-GPU M-x surface on canvas.

The returned frame owns no native window and no raster backing texture. Its prepared semantic commands are replayed by the host application's existing GPU pass.

let*
port
find-port:server-path'
:luv-gpu
manager
or
first
climi::frame-managersport
make-instance'luv-frame-manager:portport
frame
let
make-application-frame'command-menu:frame-managermanager:enablet:owner-frameowner-frame:command-tablescommand-tables:inheritedinherited
setf
frame-pretty-nameframe
title
handler-case
let
unless
and
mirror-embedded-pmirror
null
mirror-texturemirror

Publish one complete initial revision before the host attaches its compositor. This is an embedded upload only, never a drawable or queue wait.

frame
error
condition
unless
eq:disowned
frame-stateframe
destroy-frameframe
errorcondition
defundestroy-command-menu

Release frame's mirror, retained buffers, and McCLIM frame ownership.

unless
eq:disowned
frame-stateframe
destroy-frameframe
nil