Skip to content

Commit

Permalink
Various changes to racket-pdb-mode
Browse files Browse the repository at this point in the history 
Eliminate some janky scenarios related to editing and motion; in some
cases faces or overlays would persist too long and/or in wrong
locations while editing.

Remove all "decorations" (face overlays plus possible racket-show
presentation) earlier.

Set the overlay property that inserts before the overlay do not become
part of it.

Have the motion handler update unless all of window-point, -start, and
-end are the same (handle case where scrolling happens to preserve
-point).

Similar to racket--pdb-change-generation, add a "generation" variable
for motion, used to ignore point-info command responses that are
outdated (although this is much less likely to occur, I think it's
still a possibility worth guarding against). Also don't do updates if
we know we're still waiting for an analysis to complete, so the
results won't be correct.

Note: When first adding racket-pdb-mode in commit 86e35ea, I moved
some face overlay helper functions from racket-xp.el to util.el to be
shared. It turns out we want to use overlays somewhat differently in
each mode, so I moved them back.

In racket-pdb-mode, we create relatively few, short-lived overlays.
Not only is it practical to keep them in a side list variable, it
speeds certain operations like removing all of them or navigating a
subset of them for things like next/previous use/def commands. Also we
create overlays with a different "front-advance" value.
  • Loading branch information
@greghendershott
greghendershott committed Mar 28, 2023
1 parent 703c518 commit 669a7e2
Show file tree
Hide file tree
Showing 3 changed files with 207 additions and 174 deletions.
293 changes: 162 additions & 131 deletions racket-pdb.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -148,91 +148,123 @@ this mode."
#'racket-pdb-pre-redisplay
t))))

(defun racket--pdb-remove-all-face-overlays ()
(racket--remove-face-overlays-in-buffer racket-xp-def-face
racket-xp-use-face
racket-xp-tail-position-face
racket-xp-tail-target-face
racket-xp-unused-face
racket-xp-error-face))

(defvar-local racket--pdb-point-motion-timer nil)
(defvar-local racket--pdb-motion-timer nil)
(defvar-local racket--pdb-motion-generation 0
"See similar `racket--pdb-change-generation' for rationale.")

(defun racket-pdb-pre-redisplay (window)
(with-current-buffer (window-buffer window)
(let ((point (window-point window))
(start (window-start window))
(end (window-end window)))
(unless (equal point (window-parameter window 'racket-pdb-point))
(set-window-parameter window 'racket-pdb-point point)
(when (timerp racket--pdb-point-motion-timer)
(cancel-timer racket--pdb-point-motion-timer))
(setq racket--pdb-point-motion-timer
(let ((point+start+end (list (window-point window)
(window-start window)
(window-end window))))
(unless (equal point+start+end
(window-parameter window 'racket-pdb-point+start+end))
(set-window-parameter window 'racket-pdb-point+start+end point+start+end)
(cl-incf racket--pdb-motion-generation)
(racket--pdb-remove-all-decorations)
(when (timerp racket--pdb-motion-timer)
(cancel-timer racket--pdb-motion-timer))
(setq racket--pdb-motion-timer
(run-with-idle-timer racket-pdb-after-motion-refresh-delay
nil ;no repeat
#'racket--pdb-motion-timer-handler
#'racket--pdb-on-motion-idle-timer
window
point
start
end))))))

(defun racket--pdb-motion-timer-handler (window point start end)
(with-current-buffer (window-buffer window)
(racket--cmd/async
nil
`(pdb-point-info ,(racket-file-name-front-to-back (racket--buffer-file-name))
,point
,start
,end)
(lambda (response)
(with-current-buffer (window-buffer window)
;; Still same point/start/end now that the response arrived?
(when (and (= point (window-point window))
(= start (window-start window))
(= end (window-end window)))
;; 1. Do racket-show of mouse-over.
(pcase (cdr (assq 'mouse-over response))
(`(,beg ,end ,text)
(racket-show text
(cond
((pos-visible-in-window-p end window)
end)
((pos-visible-in-window-p beg window)
beg)
((save-excursion
(goto-char (window-start window))
(forward-line -1)
(point))))))
(_ (racket-show "")))

;; 2. Add overlays to highlight defs and uses.
(let ((def (cdr (assq 'def-site response)))
(uses (cdr (assq 'use-sites response))))
(racket--remove-face-overlays-in-buffer racket-xp-def-face
point+start+end))))))

(defun racket--pdb-on-motion-idle-timer (window point+start+end)
(pcase-let ((generation-of-our-request racket--pdb-motion-generation)
(`(,point ,start ,end) point+start+end))
(with-current-buffer (window-buffer window)
(racket--cmd/async
nil
`(pdb-point-info ,(racket-file-name-front-to-back (racket--buffer-file-name))
,point
,start
,end)
(lambda (response) ;called later
(when (and (= generation-of-our-request racket--pdb-motion-generation)
(racket--pdb-analysis-is-up-to-date-p))
(with-current-buffer (window-buffer window)
;; Still same point+start+end now that the response arrived?
(when (and (= point (window-point window))
(= start (window-start window))
(= end (window-end window)))
(let ((inhibit-modification-hooks t))
;; 1. Do racket-show of mouse-over.
(pcase (cdr (assq 'mouse-over response))
(`(,beg ,end ,text)
(racket-show text
(cond
((pos-visible-in-window-p end window)
end)
((pos-visible-in-window-p beg window)
beg)
((save-excursion
(goto-char (window-start window))
(forward-line -1)
(point))))))
(_ (racket-show "")))

;; 2. Add overlays to highlight defs and uses.
(let ((def (cdr (assq 'def-site response)))
(uses (cdr (assq 'use-sites response))))
(racket--pdb-remove-face-overlays racket-xp-def-face
racket-xp-use-face)
(when def
(racket--add-face-overlay (car def) (cdr def) racket-xp-def-face))
(dolist (use uses)
(racket--add-face-overlay (car use) (cdr use) racket-xp-use-face)))

;; 3. Add overlays to highight tail positions.
;; TODO.

;; 4. Add overlays for unused requires and definitions
(dolist (v (cdr (assq 'unused-requires response)))
(racket--add-face-overlay (car v) (cdr v) racket-xp-unused-face))
(dolist (v (cdr (assq 'unused-bindings response)))
(pcase-let ((`(,beg . ,end) v))
(when (string-match-p racket-pdb-highlight-unused-regexp
(buffer-substring beg end))
(racket--add-face-overlay beg end racket-xp-unused-face))))))))))
(when def
(racket--pdb-add-face-overlay (car def) (cdr def) racket-xp-def-face))
(dolist (use uses)
(racket--pdb-add-face-overlay (car use) (cdr use) racket-xp-use-face)))

;; 3. Add overlays to highight tail positions.
;; TODO.

;; 4. Add overlays for unused requires and definitions
(dolist (v (cdr (assq 'unused-requires response)))
(racket--pdb-add-face-overlay (car v) (cdr v) racket-xp-unused-face))
(dolist (v (cdr (assq 'unused-bindings response)))
(pcase-let ((`(,beg . ,end) v))
(when (string-match-p racket-pdb-highlight-unused-regexp
(buffer-substring beg end))
(racket--pdb-add-face-overlay beg end racket-xp-unused-face)))))))))))))

(defun racket--pdb-show-after-motion ()
"Useful when a command doesn't move but wants to force showing."
(let ((window (selected-window)))
(racket--pdb-motion-timer-handler window
(window-point window)
(window-start window)
(window-end window))))
(racket--pdb-on-motion-idle-timer window
(list (window-point window)
(window-start window)
(window-end window)))))

;;; Face overlays

(defvar-local racket--pdb-face-overlays nil)

(defun racket--pdb-add-face-overlay (beg end face &optional priority)
(let ((o (make-overlay beg end
nil ;current-buffer
t ;inserts in front do not go into overlay
nil ;inserts at back do not go into overlay
)))
(overlay-put o 'priority (or priority 0)) ;below other overlays e.g. isearch
(overlay-put o 'face face)
(push o racket--pdb-face-overlays)
o))

(defun racket--pdb-remove-face-overlays (&rest faces)
(setq racket--pdb-face-overlays
(seq-filter (lambda (o)
(if (memq (overlay-get o 'face) faces)
(progn (delete-overlay o) nil)
t))
racket--pdb-face-overlays)))

(defun racket--pdb-remove-all-face-overlays ()
(mapc #'delete-overlay racket--pdb-face-overlays)
(setq racket--pdb-face-overlays nil))

(defun racket--pdb-remove-all-decorations ()
(racket--pdb-remove-all-face-overlays)
(racket-show ""))

;;; Errors

Expand All @@ -241,11 +273,11 @@ this mode."
(defvar-local racket--pdb-errors-index -1)

(defun racket--pdb-reset-errors (errors)
(racket--remove-face-overlays-in-buffer racket-xp-error-face)
(racket--pdb-remove-face-overlays racket-xp-error-face)
(let ((errors (sort errors (lambda (a b) (< (car a) (car b))))))
(dolist (e errors)
(pcase-let ((`(,beg ,end . ,_) e))
(racket--add-face-overlay beg end racket-xp-error-face)))
(racket--pdb-add-face-overlay beg end racket-xp-error-face)))
(setq racket--pdb-errors (apply #'vector errors))
(setq racket--pdb-errors-index -1)))

Expand Down Expand Up @@ -290,32 +322,35 @@ evaluation errors that won't be found merely from expansion -- or

;;; Change hook and idle timer

(defvar-local racket--pdb-analyze-idle-timer nil)
(defvar-local racket--pdb-change-idle-timer nil)

(defvar-local racket--pdb-edit-generation 0
"A counter to detect check-syntax command responses we should ignore.
(defvar-local racket--pdb-change-generation 0
"A counter to detect pdb-analyze command responses we should ignore.
Example scenario: User edits. Timer set. Timer expires; we
request annotations. While waiting for that response, user makes
more edits. When the originally requested annotations arrive, we
can see they're out of date and should be ignored. Instead just wait
for the annotations resulting from the user's later edits.")

(defvar-local racket--pdb-change-response-generation 0)
(defun racket--pdb-analysis-is-up-to-date-p ()
(= racket--pdb-change-generation
racket--pdb-change-response-generation))

(defun racket--pdb-after-change-hook (_beg _end _len)
(cl-incf racket--pdb-edit-generation)
(when (timerp racket--pdb-analyze-idle-timer)
(cancel-timer racket--pdb-analyze-idle-timer))
(cl-incf racket--pdb-change-generation)
(racket--pdb-remove-all-decorations)
(when (timerp racket--pdb-change-idle-timer)
(cancel-timer racket--pdb-change-idle-timer))
(racket--pdb-set-status 'outdated)
(when racket-pdb-after-change-refresh-delay
(racket--pdb-start-idle-timer (current-buffer))))

(defun racket--pdb-start-idle-timer (buffer)
(setq racket--pdb-analyze-idle-timer
(run-with-idle-timer racket-pdb-after-change-refresh-delay
nil ;no repeat
#'racket--pdb-on-idle-timer
buffer)))
(setq racket--pdb-change-idle-timer
(run-with-idle-timer racket-pdb-after-change-refresh-delay
nil ;no repeat
#'racket--pdb-on-change-idle-timer
(current-buffer)))))

(defun racket--pdb-on-idle-timer (buffer)
(defun racket--pdb-on-change-idle-timer (buffer)
"Handle after-change-hook => idle-timer expiration.
One scenario to keep in mind: The user has typed a few characters
Expand Down Expand Up @@ -345,18 +380,19 @@ This is ad hoc and forensic."
(defun racket-pdb-analyze ()
(interactive)
(racket--pdb-set-status 'running)
(let ((generation-of-our-request racket--pdb-edit-generation))
(let ((generation-of-our-request racket--pdb-change-generation))
(racket--cmd/async
nil
`(pdb-analyze-path ,(racket-file-name-front-to-back
(or (racket--buffer-file-name) (buffer-name)))
,(buffer-substring-no-properties (point-min) (point-max)))
(lambda (response)
(when (= generation-of-our-request racket--pdb-edit-generation)
(lambda (response) ;arrives later
(when (= generation-of-our-request racket--pdb-change-generation)
(setq racket--pdb-change-response-generation generation-of-our-request)
(pcase response
(`((completions . ,completions)
(errors . ,errors))
(racket--pdb-remove-all-face-overlays)
(racket--pdb-remove-all-decorations)
(when completions ;if none b/c e.g. error, retain old ones
(setq racket--xp-binding-completions completions)) ;racket-xp-complete.el
(racket--pdb-reset-errors errors)
Expand Down Expand Up @@ -424,7 +460,7 @@ Uses pdb to query for sites among multiple files."
(let ((file (racket-file-name-back-to-front (car file-and-sites))))
(with-current-buffer (save-selected-window (find-file file))
(when racket-pdb-mode
(racket--pdb-remove-all-face-overlays)
(racket--pdb-remove-all-decorations)
(racket-pdb-analyze)))))))

;;; xref
Expand Down Expand Up @@ -533,42 +569,37 @@ Uses pdb to query for sites among multiple files."

;;; Next/previous use

(defun racket--pdb-def-or-use-overlay-at (pos)
(seq-some (lambda (o)
(and (memq (overlay-get o 'face)
'(racket-xp-def-face racket-xp-use-face))
o))
(overlays-at pos)))

(defun racket-pdb-next-use ()
(defun racket--pdb-forward-use (amt)
(let* ((os (seq-filter (lambda (o)
(and (memq (overlay-get o 'face)
'(racket-xp-def-face
racket-xp-use-face))
o))
racket--pdb-face-overlays))
(sorted (sort os (lambda (a b)
(< (overlay-start a) (overlay-start b)))))
(vec (apply #'vector sorted))
(pt (point)))
(if-let (ix (seq-position vec
nil
(lambda (o _o)
(and (<= (overlay-start o) pt)
(< pt (overlay-end o))))))
(progn
(goto-char (overlay-start (aref vec (mod (+ ix amt)
(length vec)))))
(racket--pdb-show-after-motion))
(user-error "No highlighted definition or use at point"))))

(defun racket-pdb-next-use (&optional amount)
"When point is a highlighted definition or use, go to the next related site."
(interactive)
(when-let (o (racket--pdb-def-or-use-overlay-at (point)))
(let ((pos (overlay-end o)))
(catch 'exit
(while t
(setq pos (next-overlay-change pos))
(when (= pos (point-max))
(throw 'exit nil))
(when-let (o (racket--pdb-def-or-use-overlay-at pos))
(goto-char (overlay-start o))
(throw 'exit nil))
(cl-incf pos))))))

(defun racket-pdb-previous-use ()
(interactive "P")
(racket--pdb-forward-use (if (numberp amount) amount 1)))

(defun racket-pdb-previous-use (&optional amount)
"When point is a highlighted definition or use, go to the previous related site."
(interactive)
(when-let (o (racket--pdb-def-or-use-overlay-at (point)))
(let ((pos (overlay-start o)))
(catch 'exit
(while t
(setq pos (previous-overlay-change pos))
(when (= pos (point-min))
(throw 'exit nil))
(when-let (o (racket--pdb-def-or-use-overlay-at pos))
(goto-char (overlay-start o))
(throw 'exit nil))
(cl-decf pos))))))
(interactive "P")
(racket--pdb-forward-use (if (numberp amount) amount -1)))

;;; Mode line status

Expand Down
22 changes: 0 additions & 22 deletions racket-util.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -160,28 +160,6 @@ The \"project\" is determined by trying, in order:
next-pos
pos))))) ;pos is last char having prop val

(defun racket--add-face-overlay (beg end face &optional priority)
(let ((o (make-overlay beg end)))
(overlay-put o 'priority (or priority 0)) ;below other overlays e.g. isearch
(overlay-put o 'face face)
(dolist (p '(modification-hooks
insert-in-front-hooks
insert-behind-hooks))
(overlay-put o p (list #'racket--modifying-overlay-deletes-it)))
(overlay-put o 'insert-in-front-hooks (list #'racket--modifying-overlay-deletes-it))
o))

(defun racket--modifying-overlay-deletes-it (o &rest _)
(let ((inhibit-modification-hooks t))
(delete-overlay o)))

(defun racket--remove-face-overlays (beg end face)
(remove-overlays beg end 'face face))

(defun racket--remove-face-overlays-in-buffer (&rest faces)
(dolist (face faces)
(racket--remove-face-overlays (point-min) (point-max) face)))

(provide 'racket-util)

;; racket-util.el ends here

0 comments on commit 669a7e2

Please sign in to comment.