mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-02-16 16:24:18 +00:00
107 lines
3.7 KiB
EmacsLisp
107 lines
3.7 KiB
EmacsLisp
(defvar bisect-top-overlay nil)
|
|
(make-variable-buffer-local 'bisect-top-overlay)
|
|
(defvar bisect-middle-overlay nil)
|
|
(make-variable-buffer-local 'bisect-middle-overlay)
|
|
(defvar bisect-bottom-overlay nil)
|
|
(make-variable-buffer-local 'bisect-bottom-overlay)
|
|
(defvar bisect-linewise t)
|
|
|
|
(defface bisect-line-face `((t (:box (:line-width 1 :color "grey75" :style released-button))))
|
|
nil)
|
|
|
|
(defvar bisect-mode-map nil)
|
|
|
|
(unless bisect-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (kbd "u") #'bisect-up-inclusive)
|
|
(define-key map (kbd "U") #'bisect-up-exclusive)
|
|
(define-key map (kbd "d") #'bisect-down-inclusive)
|
|
(define-key map (kbd "D") #'bisect-down-exclusive)
|
|
(define-key map (kbd "g") #'bisect-goto-current-middle)
|
|
(define-key map (kbd "SPC") #'bisect-goto-current-middle)
|
|
(define-key map (kbd "C-SPC") #'bisect-middle-here)
|
|
(define-key map (kbd "q") #'bisect-mode)
|
|
(define-key map (kbd "p") #'previous-line)
|
|
(define-key map (kbd "n") #'next-line)
|
|
(setq bisect-mode-map map)))
|
|
|
|
(defun move-overlay-to-line (overlay line)
|
|
(save-excursion
|
|
(goto-line line)
|
|
(move-overlay overlay
|
|
(point-at-bol)
|
|
(point-at-eol))))
|
|
|
|
(defun bisect-make-overlay (line bitmap)
|
|
(save-excursion
|
|
(goto-line line)
|
|
(let ((overlay (make-overlay (point-at-bol) (point-at-eol))))
|
|
(overlay-put overlay 'before-string
|
|
(propertize "!" 'display
|
|
(list 'left-fringe
|
|
bitmap)))
|
|
(overlay-put overlay 'face 'bisect-line-face)
|
|
overlay)))
|
|
|
|
(defun bisect-overlay-line (overlay &optional eol)
|
|
(line-number-at-pos
|
|
(funcall (if eol #'overlay-end #'overlay-start)
|
|
overlay)))
|
|
|
|
(define-minor-mode bisect-mode ""
|
|
nil nil bisect-mode-map
|
|
(if (not bisect-mode)
|
|
(mapcar #'delete-overlay (list bisect-middle-overlay
|
|
bisect-top-overlay
|
|
bisect-bottom-overlay))
|
|
(let ((top (line-number-at-pos (if mark-active (region-beginning) (point-min))))
|
|
(bottom (line-number-at-pos (if mark-active (region-end) (point-max)))))
|
|
(when (region-active-p) (pop-mark))
|
|
(setq bisect-top-overlay (bisect-make-overlay top 'right-arrow))
|
|
(setq bisect-bottom-overlay (bisect-make-overlay bottom 'right-arrow))
|
|
(setq bisect-middle-overlay (bisect-make-overlay bottom 'right-triangle)))
|
|
(bisect-find-middle)))
|
|
|
|
(defun bisect-find-middle ()
|
|
(let* ((average (/ (+ (bisect-overlay-line bisect-top-overlay)
|
|
(bisect-overlay-line bisect-bottom-overlay))
|
|
2)))
|
|
(goto-line average)
|
|
(bisect-middle-here)
|
|
(recenter)))
|
|
|
|
(defun bisect-middle-here ()
|
|
(interactive)
|
|
(move-overlay-to-line bisect-middle-overlay
|
|
(line-number-at-pos)))
|
|
|
|
(defun bisect-up-inclusive ()
|
|
(interactive)
|
|
(move-overlay-to-line bisect-bottom-overlay
|
|
(bisect-overlay-line bisect-middle-overlay))
|
|
(bisect-find-middle))
|
|
|
|
(defun bisect-down-inclusive ()
|
|
(interactive)
|
|
(move-overlay-to-line bisect-top-overlay
|
|
(bisect-overlay-line bisect-middle-overlay))
|
|
(bisect-find-middle))
|
|
|
|
(defun bisect-up-exclusive ()
|
|
(interactive)
|
|
(move-overlay-to-line bisect-bottom-overlay
|
|
(1- (bisect-overlay-line bisect-middle-overlay)))
|
|
(bisect-find-middle))
|
|
|
|
(defun bisect-down-exclusive ()
|
|
(interactive)
|
|
(move-overlay-to-line bisect-top-overlay
|
|
(1+ (bisect-overlay-line bisect-middle-overlay)))
|
|
(bisect-find-middle))
|
|
|
|
(defun bisect-goto-current-middle ()
|
|
(interactive)
|
|
(goto-char (overlay-start bisect-middle-overlay))
|
|
(recenter))
|
|
|
|
(provide 'bisect-mode)
|