[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: more VTP/ctedit questions
=> Some more questions about selections:
=>
=> -----------------------------------------------------------------
=>
=> How can I do multiple selections in a ctedit window? E.g., I want to
=> write a function that selects nodes satisfying a given property (e.g,
=> select all metavariables). I've written the function
=> {tree}:for-all-subtrees that does the recursive tree traversal, but
=> how do I add the selections?
=>
=> (de {tree}:for-all-subtrees (tree function)
=> ;; apply FUNCTION recursively to all subtrees of TREE.
=> ;; FUNCTION takes one argument: a tree.
=> ({tree}:for-all-sons
=> tree
=> (lambda (tree)
=> (funcall function tree)
=> ({tree}:for-all-subtrees tree function))))
An answer may be found in the Centaur tutorial, chapter 6.9 "Adding a
selection".
You must first choose a selection name to hold the multiple path. The
selection name must be unique, and derive from '{union}. Let us call the
selection {union}:meta.
Then create a select, associated with a ctedit (the selection is automatically
created on the ctedit subject):
({ctedit}:create-select <ct> '{union}:meta '{textual}:all)
Use a global variable to store the extra <selection> parameter:
(defvar :selection-meta)
(de compute-meta (ctedit)
(let* ((variable ({ctedit}:subject ctedit)
(:selection-meta
({variable}:find-selection variable '{union}:meta))
(tree ({variable}:root variable)
)
({selection}:change :selection ()) ;; resets the selection.
({tree}:for-all-subtrees tree 'select-meta)
)
)
(de select-meta (tree)
;; merges the tree path into the global variable :selection when tree is a
;; meta
(when ({metavariable}:p tree)
({selection}:merge :selection ({tree}:path tree))
)
)
(de display-meta (ctedit)
(when ({ctedit}:update-select ctedit
({ctedit}:find-select ctedit '{union}:meta))
)
({ctedit}:incremental-redisplay ctedit)
)
)
If :selection were not a global variable, the code for compute-meta and
select-meta could not be compiled safely.
I'm not sure that {union} is the proper type and merge the proper operation
to gather meta-variables in a path.
=>
=>
=> In this example, I'm mostly interested in the visible effect of the
=> selections, and not necessarily in their availability via the
=> {ctedit}:find-selection function. I've seen in the manual that there
=> is a difference between "selections" and "selects", but it is not
=> clear to me whether they are necessarily coupled or not.
Selections are not necessarily coupled with a select.
Selects are objects which enable selections to be drawn on the screen.
Every select must be bound to a selection.
=>
=> -----------------------------------------------------------------
=>
=> Is there a better/faster way to test whether a tree is
=> a metavariable or not? Can I get rid of the formalism argument?
=>
=> (de {metavariable}:p (tree formalism)
=> ;; Returns t if TREEE is a metavariable of FORMALISM
=> (eq ({tree}:operator tree)
=> ({name}:operator 'meta formalism)))
(de {metavariable}:p (tree)
(eq ({operator}:name ({tree}:operator tree)) 'meta))
=>
=>
=> -----------------------------------------------------------------
=>
=> I would like to see the code for the mouse handlers of a ctedit. There
=> are some utility fumctions documented in the manual, but I need an
=> example to see how fit together.
=>
=> -----------------------------------------------------------------
Here is the code. Maybe you can test the not yet
documented {ctedit}:zoom:mouse-down function.
; $Id: ct-mouse.ll,v 1.4 91/12/04 18:10:05 fm Exp $
(setq #:sys-package:colon '{ctedit})
(defvar :down-path ())
(de :current:mouse-down (ctedit event)
;----------------------
; Builds a selection of sub-type '{current} for the tree
; located at the mouse position.
;
(let ((select (:find-select ctedit '{current}))
selection
)
(when select
(setq :down-path
(:get-subject-path ctedit (send 'image-path ctedit event))
selection ({select}:selection select)
)
(unless ({path}:equal ({selection}:path selection) :down-path)
({selection}:change selection :down-path)
(when (:update-select ctedit select)
(send 'incremental-redisplay ctedit)
)
)
)
)
)
(de :current:mouse-drag (ctedit event)
;----------------------
; Builds a selection by merging a path corresponding to the tree
; located at the current mouse position to an initial path
; corresponding to the tree located at the mouse position
; on the "mouse-down" event. The selection type {current} is
; a sub-type of {single}.
;
(let ((select (:find-select ctedit '{current}))
(path (:get-subject-path ctedit
(send 'image-path ctedit event)
)
)
selection
old-path
)
(when (and select path)
(setq selection ({select}:selection select)
old-path ({selection}:path selection)
)
(when (null :down-path)
(setq :down-path path))
({single}:ancestor-merge
selection
:down-path
path
)
(unless ({path}:equal
old-path
({selection}:path selection)
)
(when (:update-select ctedit select)
(send 'incremental-redisplay ctedit)
)
)
)
)
)
(de :current:mouse-up (ctedit event)
;--------------------
; Resets the Lisp variable :down-path.
;
(setq :down-path ())
({node-object}:emit ({ctedit}:subject ctedit)
'{variable}:variable:selection-modified
'{current})
)
(de #:event:modifier (event)
;;; ----------------
;;;
(selectq (mul 3 (div (#:event:detail event) 3))
(0 'none)
(3 'shift)
(6 'ctrl)
(9 'ctrl-shift)
)
)
(de {ctedit}:zoom:mouse-down (ctedit event)
;;; ------------------------
;;; click : expand.
;;; shift-click : shrink
;;; ctrl-click : redraw (and resets all tags in substructures).
;;; ctrl-shift-click :redraw (but does not remove tags on substructures)
;;;
(let ((modifier (#:event:modifier event)))
(:set-print-level-tag
ctedit
(:get-subject-path ctedit (send 'image-path ctedit event))
(selectq modifier
(none 'expand)
(shift 'shrink)
(ctrl 0)
(ctrl-shift 0)
(t 0)
)
(selectq modifier
((none shift ctrl-shift) ())
(t t)
)
)
(:incremental-redisplay ctedit)
)
)
(de {ctedit}:register-mouse-handler (ctedit button handler)
;;; -------------------------------
;;; <button> may be left, middle or right.
;;; A null <handler> resets the corresponding <button>.
;;; Example : ({ctedit}:register-mouse-handler ct 'middle '{ctedit}:zoom)
;;;
(let* ((mouse-event-list
(#:properties:get-property ctedit 'MouseEventList)
)
(redef (assq button mouse-event-list))
)
(when (eq mouse-event-list 'none)
;; Normalization
(setq mouse-event-list ())
)
(ifn handler
(setq mouse-event-list (delq redef mouse-event-list))
(if redef
(rplacd redef handler)
(setq mouse-event-list (acons button handler mouse-event-list))
)
)
(#:properties:set-user-property
ctedit
'MouseEventList
(or mouse-event-list 'none)
)
)
)
Vincent