;; Requires `ambrevar/sly-end-of-prompt-p'.

(defun ambrevar/sly-prompt-begin-position ()
  (cond
   ((and (get-text-property (point) 'sly-mrepl--prompt)
         (not (get-text-property (1- (point)) 'sly-mrepl--prompt)))
    (point))
   ((or (get-text-property (point) 'sly-mrepl--prompt)
        (ambrevar/sly-end-of-prompt-p))
    (previous-single-char-property-change
     (point) 'sly-mrepl--prompt))
   (t (previous-single-char-property-change
       (previous-single-char-property-change
        (point) 'sly-mrepl--prompt)
       'sly-mrepl--prompt))))

(defun ambrevar/sly-prompt-end-position ()
  (save-excursion
    (goto-char (ambrevar/sly-prompt-begin-position))
    (call-interactively #'sly-mrepl-next-prompt)
    (point)))

(defun ambrevar/sly-output-end-position ()
  (if (get-text-property (point) 'sly-mrepl--prompt)
      (next-single-char-property-change
       (next-single-char-property-change
        (point) 'sly-mrepl--prompt)
       'sly-mrepl--prompt)
    (next-single-char-property-change
     (point) 'sly-mrepl--prompt)))

(defun ambrevar/sly-narrow-to-prompt ()
  "Narrow buffer to prompt at point."
  (interactive)
  (narrow-to-region
   (ambrevar/sly-prompt-begin-position)
   (ambrevar/sly-output-end-position)))

(with-eval-after-load 'sly-mrepl
  (define-key sly-mrepl-mode-map (kbd "C-x n d") 'ambrevar/sly-narrow-to-prompt))

(provide 'init-sly-narrow)