82 lines
3.2 KiB
Common Lisp
82 lines
3.2 KiB
Common Lisp
(uiop:define-package :sextant/models/actions
|
||
(:use :cl :eql :qml :options
|
||
:sextant/org/nodes
|
||
:sextant/models/org-model))
|
||
(in-package :sextant/models/actions)
|
||
|
||
(defvar *last-command* nil)
|
||
|
||
(defmacro defaction (action-name types &body body)
|
||
(declare (ignore types))
|
||
`(prog1
|
||
(defun ,action-name (ui-item node coords)
|
||
(declare (ignorable ui-item node coords))
|
||
(flet ((repeat-command-p ()
|
||
(and (eq ',action-name (first *last-command*))
|
||
(eq node (third *last-command*)))))
|
||
,@body)
|
||
(setf *last-command* (list ',action-name node))
|
||
nil)
|
||
(push-action (symbol-name ',action-name) ',types)))
|
||
|
||
(defaction collapse/expand (org-headline)
|
||
(qjs |setFocus| ui-item)
|
||
(ecase (property-of node :visibility)
|
||
(:collapsed (expand-headline))
|
||
(:expanded
|
||
(if (and (repeat-command-p)
|
||
(next-headline-of node)
|
||
(> (depth-of (next-headline-of node)) (depth-of node)))
|
||
(ecase (property-of (next-headline-of node) :visibility)
|
||
(:collapsed (expand-headline t))
|
||
(:expanded (collapse-headline)))
|
||
(collapse-headline)))))
|
||
|
||
(defaction raw-edit (org-line org-headline)
|
||
(qjs |setFocus| ui-item)
|
||
(qjs |setCursorPositionAt| ui-item (car coords) (cdr coords))
|
||
(qjs |editRawText| ui-item))
|
||
|
||
(defaction nothing (org-line org-headline)
|
||
)
|
||
|
||
|
||
|
||
(defmacro defaction-type (type)
|
||
`(progn
|
||
,(let ((symbol (intern (concatenate 'string (symbol-name type) "-CLICKED")))
|
||
(funsym (intern (concatenate 'string "CLICK-ON-" (symbol-name type))
|
||
:sextant/options/options)))
|
||
`(prog1
|
||
(defun ,symbol (index x y)
|
||
(let ((funsym ,funsym))
|
||
(when funsym
|
||
(let ((fun (intern funsym #.*package*)))
|
||
(when (fboundp fun)
|
||
(funcall fun *caller* (goto-visual-index index) (cons x y)))))))
|
||
(export ',symbol)))
|
||
,(let ((symbol (intern (concatenate 'string (symbol-name type) "-DOUBLE-CLICKED")))
|
||
(funsym (intern (concatenate 'string "DOUBLE-CLICK-ON-" (symbol-name type))
|
||
:sextant/options/options)))
|
||
`(prog1
|
||
(defun ,symbol (index x y)
|
||
(let ((funsym ,funsym))
|
||
(when funsym
|
||
(let ((fun (intern funsym #.*package*)))
|
||
(when (fboundp fun)
|
||
(funcall fun *caller* (goto-visual-index index) (cons x y)))))))
|
||
(export ',symbol)))
|
||
,(let ((symbol (intern (concatenate 'string (symbol-name type) "-PRESS-AND-HOLD")))
|
||
(funsym (intern (concatenate 'string "PRESS-AND-HOLD-ON-" (symbol-name type))
|
||
:sextant/options/options)))
|
||
`(prog1
|
||
(defun ,symbol (index x y)
|
||
(let ((funsym ,funsym))
|
||
(when funsym
|
||
(let ((fun (intern funsym #.*package*)))
|
||
(when (fboundp fun)
|
||
(funcall fun *caller* (goto-visual-index index) (cons x y)))))))
|
||
(export ',symbol)))))
|
||
|
||
(defaction-type org-line)
|
||
(defaction-type org-headline)
|