diff options
Diffstat (limited to '.config/emacs/lisp/sideline.el')
| -rw-r--r-- | .config/emacs/lisp/sideline.el | 908 |
1 files changed, 908 insertions, 0 deletions
diff --git a/.config/emacs/lisp/sideline.el b/.config/emacs/lisp/sideline.el new file mode 100644 index 0000000..e989456 --- /dev/null +++ b/.config/emacs/lisp/sideline.el @@ -0,0 +1,908 @@ +;;; sideline.el --- Show information on the side -*- lexical-binding: t; -*- + +;; Copyright (C) 2022-2026 Shen, Jen-Chieh +;; Created date 2022-06-13 22:08:26 + +;; Author: Shen, Jen-Chieh <jcs090218@gmail.com> +;; URL: https://github.com/emacs-sideline/sideline +;; Version: 0.2.0 +;; Package-Requires: ((emacs "28.1") (ht "2.4")) +;; Keywords: convenience + +;; This file is NOT part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This library provides the frontend UI to display information either on the +;; left/right side of the buffer window. +;; +;; 1) You would need to first set up the backends, +;; +;; (setq sideline-backends-left '(sideline-flycheck)) +;; +;; 2) Then enable the sideline in the target buffer, +;; +;; M-x sideline-mode +;; +;; For backends choice, see https://github.com/emacs-sideline/sideline#-example-projects +;; + +;;; Code: + +(require 'cl-lib) +(require 'face-remap) +(require 'mule-util) +(require 'rect) +(require 'subr-x) + +(require 'ht) + +(defgroup sideline nil + "Show information on the side." + :prefix "sideline-" + :group 'tool + :link '(url-link :tag "Repository" "https://github.com/emacs-sideline/sideline")) + +(defcustom sideline-backends-left nil + "The list of active backends to display sideline on the left." + :type '(list symbol) + :group 'sideline) + +(defcustom sideline-backends-right nil + "The list of active backends to display sideline on the right." + :type '(list symbol) + :group 'sideline) + +(defcustom sideline-order-left 'down + "Display order on the left sidelines." + :type '(choice (const :tag "Search up" up) + (const :tag "Search down" down)) + :group 'sideline) + +(defcustom sideline-order-right 'up + "Display order on the right sidelines." + :type '(choice (const :tag "Search up" up) + (const :tag "Search down" down)) + :group 'sideline) + +(defcustom sideline-force-display-if-exceeds nil + "Display sideline even if the line width are wider than the window width." + :type 'boolean + :group 'sideline) + +(defcustom sideline-truncate t + "Truncate sideline if the line width are wider than the window width." + :type 'boolean + :group 'sideline) + +(defface sideline-default + '((((background light)) :foreground "DarkOrange") + (t :foreground "yellow")) + "Face used to highlight action text." + :group 'sideline) + +(defface sideline-backend + '((((background light)) :foreground "#7F7F7F") + (t :foreground "#9B9B9B")) + "Face used to highlight action text." + :group 'sideline) + +(defcustom sideline-display-backend-name nil + "Weather to display backend name in the candidate." + :type 'boolean + :group 'sideline) + +(defcustom sideline-display-backend-type 'outer + "Method type to display backend name." + :type '(choice (const :tag "Display on left" left) + (const :tag "Display on right" right) + (const :tag "Display on inner" inner) + (const :tag "Display on outer" outer)) + :group 'sideline) + +(defcustom sideline-display-backend-format "[%s]" + "Format string for candidate and backend name." + :type 'string + :group 'sideline) + +(defcustom sideline-backends-left-skip-current-line t + "Don't display left sideline in current line." + :type 'boolean + :group 'sideline) + +(defcustom sideline-backends-right-skip-current-line t + "Don't display right sideline in current line." + :type 'boolean + :group 'sideline) + +(defcustom sideline-format-left "%s " + "Format candidate string for left alignment." + :type 'string + :group 'sideline) + +(defcustom sideline-format-right " %s" + "Format candidate string for right alignment." + :type 'string + :group 'sideline) + +(defcustom sideline-priority 100 + "Overlays' priority." + :type 'integer + :group 'sideline) + +(defcustom sideline-delay 0.2 + "Number of seconds to wait before showing sideline." + :type 'number + :group 'sideline) + +(defcustom sideline-backend-delays nil + "Number of seconds to wait before showing sideline per backend." + :type '(list symbol) + :group 'sideline) + +(defcustom sideline-pre-render-hook nil + "Hooks runs before rendering sidelines." + :type 'hook + :group 'sideline) + +(defcustom sideline-post-render-hook nil + "Hooks runs after rendering sidelines." + :type 'hook + :group 'sideline) + +(defcustom sideline-reset-hook nil + "Hooks runs once the sideline is reset in `post-command-hook'." + :type 'hook + :group 'sideline) + +(defcustom sideline-inhibit-display-function #'sideline-stop-p + "Function call to determine weather to display sideline or not." + :type 'function + :group 'sideline) + +(defvar-local sideline--render-data nil + "Data used to render; only used everytime before rendering.") + +(defvar-local sideline--render-data-wapp (make-hash-table) + "Record pixel position; only used everytime before rendering.") + +(defvar-local sideline--overlays (make-hash-table) + "Displayed overlays.") + +(defvar-local sideline--ex-bound-or-point nil + "Record of last bound; if this isn't the same, clean up overlays.") + +(defvar-local sideline--occupied-lines-left nil + "Occupied lines on the left.") + +(defvar-local sideline--occupied-lines-right nil + "Occupied lines on the right.") + +(defvar-local sideline--text-scale-mode-amount nil + "Record of last variable `text-scale-mode-amount'.") + +(defvar-local sideline-render-this-command nil + "If this is non-nil, re-render this command.") + +(defvar-local sideline--max-remain-spaces nil + "Hold the maximum remaining spaces when finding lines..") + +(defvar-local sideline--max-remain-spaces-line nil + "Hold the line information that has the maximum remaining spaces.") + +;; +;; (@* "Render Flags" ) +;; + +(defvar-local sideline--ex-window nil + "Holds previous window.") + +(defvar-local sideline--ex-window-start nil + "Holds previous window start point; detect vertical scrolling.") + +(defvar-local sideline--ex-window-hscroll nil + "Holds previous window hscroll; detect horizontal scrolling.") + +(defvar-local sideline--ex-window-width nil + "Holds previous window width; detect size change.") + +(defvar-local sideline--ex-window-height nil + "Holds previous window height; detect size change.") + +(defvar-local sideline--ex-face-remapping-alist nil + "Holds previous face remapping alist.") + +;; +;; (@* "Externals" ) +;; + +(defvar overflow-newline-into-fringe) + +(declare-function buffer-text-pixel-size "src/xdisp.c") + +(declare-function shr-string-pixel-width "shr.el") ; TODO: remove this after 29.1 + +(defun sideline--handle-externals () + "Alter external packages to work with `sideline'." + (add-hook 'whitespace-mode-hook #'sideline-render-this) + ;; Tree-sitter + (add-hook 'ts-fold-on-fold-hook #'sideline-render-this) + (add-hook 'treesit-fold-on-fold-hook #'sideline-render-this)) + +;; +;; (@* "Entry" ) +;; + +(defun sideline--enable () + "Enable `sideline' in current buffer." + (setq sideline-backends-left (cl-remove-if #'null sideline-backends-left) + sideline-backends-right (cl-remove-if #'null sideline-backends-right)) + ;; XXX: Still don't know why local variable doesn't work! + (progn + (sideline--delete-ovs) + (setq-local sideline--overlays (make-hash-table) + sideline--backend-delay-timers (make-hash-table))) + (setq sideline--render-data-wapp (make-hash-table) + sideline--ex-bound-or-point t ; reset, render immediately + sideline--text-scale-mode-amount text-scale-mode-amount) + (add-hook 'post-command-hook #'sideline--post-command -90 t) + (add-hook 'before-revert-hook #'sideline--before-revert nil t) + (sideline--handle-externals) + ;; Render immediately after reopened file! + (sideline--post-command)) + +(defun sideline--disable () + "Disable `sideline' in current buffer." + (remove-hook 'post-command-hook #'sideline--post-command t) + (remove-hook 'before-revert-hook #'sideline--before-revert t) + (sideline--reset)) + +;;;###autoload +(define-minor-mode sideline-mode + "Minor mode `sideline-mode'." + :lighter " Sideline" + :group sideline + (if sideline-mode (sideline--enable) (sideline--disable))) + +(defun sideline--turn-on-sideline-mode () + "Turn on the `sideline-mode'." + (sideline-mode 1)) + +;;;###autoload +(define-globalized-minor-mode global-sideline-mode + sideline-mode sideline--turn-on-sideline-mode + :require 'sideline) + +;; +;; (@* "Util" ) +;; + +(defun sideline-2str (obj) + "Convert OBJ to string." + (format "%s" obj)) + +;; Copied from s.el +(defun sideline--s-replace (old new s) + "Replace OLD with NEW in S." + (declare (pure t) (side-effect-free t)) + (replace-regexp-in-string (regexp-quote old) new s t t)) + +(defmacro sideline--with-buffer-window (buffer-or-name &rest body) + "Execute the forms in BODY with BUFFER-OR-NAME temporarily current." + (declare (indent 1) (debug t)) + `(when-let* (((buffer-live-p ,buffer-or-name)) + (window (get-buffer-window ,buffer-or-name))) + (with-selected-window window + (with-current-buffer ,buffer-or-name ,@body)))) + +(defun sideline--window-hscroll () + "Like function `window-hscroll' but take more stuff into account." + (ceiling (* (window-hscroll) + (/ 1.0 (expt text-scale-mode-step + text-scale-mode-amount))))) + +;; TODO: Use function `string-pixel-width' after 29.1 +(defun sideline--string-pixel-width (str) + "Return the width of STR in pixels." + (cond ((fboundp #'buffer-text-pixel-size) + (let ((remapping-alist face-remapping-alist)) + ;; Prevent use original buffer name for minimal side-effects + (with-current-buffer (get-buffer-create " *sideline-string-pixel-width*") + (setq-local display-line-numbers nil) + (delete-region (point-min) (point-max)) + (setq-local face-remapping-alist remapping-alist) + (insert str) + (car (buffer-text-pixel-size nil nil t))))) + (t + (require 'shr) + (shr-string-pixel-width str)))) + +(defun sideline--to-text-width (w) + "Convert pixel W to row/column width." + (let ((width (window-font-width))) + (+ (/ w width) + (if (zerop (% w width)) 0 1)))) ; add one if exceeed + +(defun sideline--str-len (str) + "Calculate STR in pixel width." + (sideline--to-text-width (sideline--string-pixel-width str))) + +(defun sideline--kill-timer (timer) + "Kill TIMER." + (when (timerp timer) (cancel-timer timer))) + +(defun sideline--column-to-point (column) + "Convert COLUMN to point." + (save-excursion (move-to-column (max column 0)) (point))) + +(defun sideline--modeline-height () + "Return lines modeline cost." + (ceiling (/ (float (window-mode-line-height)) (frame-char-height)))) + +(defun sideline--window-end () + "Return the accurate window end position." + (save-excursion + (goto-char (window-end)) + (forward-visible-line (- 0 (sideline--modeline-height))) + (line-beginning-position))) + +(defun sideline--window-width () + "Correct window width for sideline." + (window-max-chars-per-line)) + +(defun sideline--overlays-in (prop name &optional beg end) + "Return overlays with PROP of NAME, from region BEG to END." + (let* ((beg (or beg (point-min))) + (end (or end (point-max))) + (lst) + (ovs (overlays-in beg end))) + (dolist (ov ovs) + (when (eq name (overlay-get ov prop)) + (push ov lst))) + lst)) + +(defun sideline--overlays-in-line () + "Return sideline overlays in line." + (sideline--overlays-in 'creator 'sideline (line-beginning-position) (line-end-position))) + +(defun sideline--opposing-str-len () + "Return opposing overlay's content length." + (if-let* ((ov (car (sideline--overlays-in-line))) ; always return length of 1 + (str (overlay-get ov 'before-string))) + (sideline--str-len str) + 0)) ; not found, then return 0 + +(defun sideline--align-right (str offset) + "Align sideline STR from the right of the window. + +Argument OFFSET is additional calculation from the right alignment." + (let ((graphic-p (display-graphic-p)) + (fringes (window-fringes))) + (list ; use pixel instead of character unit + (+ (sideline--string-pixel-width str) + (* (window-font-width) + (+ offset + ;; If the sideline text is displayed without at least 1 pixel gap from the right fringe and + ;; overflow-newline-into-fringe is not true, emacs will line wrap it. + (if (and graphic-p + (> (nth 1 fringes) 0) + (not overflow-newline-into-fringe)) + 1 + 0) + (if graphic-p + ;; If right fringe deactivated add 1 offset + (if (= 0 (nth 1 fringes)) 1 0) + 1) + (if (or + (bound-and-true-p whitespace-mode) + (bound-and-true-p global-whitespace-mode)) + 1 + 0))))))) + +(defun sideline--line-pixel-start () + "Return the pixel start of the line." + (let* ((bol (line-beginning-position)) + (left (car (save-excursion + (goto-char bol) + (or (ht-get sideline--render-data-wapp bol) + (let ((wapp (window-absolute-pixel-position))) + (ht-set sideline--render-data-wapp bol wapp) + wapp))))) + (left-edge (window-pixel-left))) + (- left left-edge))) + +(defun sideline--line-pixel-end () + "Return the pixel end of the line." + (let* ((eol (line-end-position)) + (left (car (save-excursion + (goto-char eol) + (or (ht-get sideline--render-data-wapp eol) + (let ((wapp (window-absolute-pixel-position))) + (ht-set sideline--render-data-wapp eol wapp) + wapp))))) + (left-edge (window-pixel-left))) + (- left left-edge))) + +(defun sideline--line-width () + "Return the width of the line." + (let* ((start (sideline--line-pixel-start)) ; in pixel + (end (sideline--line-pixel-end)) ; in pixel + (len (- end start))) + (sideline--to-text-width len))) ; to text space + +(defun sideline--exceed-display-p () + "Return non-nil if exceed display." + (or sideline-force-display-if-exceeds + sideline-truncate)) + +(defun sideline--calc-space (str-len on-left opposing-str-len bol) + "Calculate space in current line. + +Argument STR-LEN is the string size. Another argument OPPOSING-STR-LEN is the +string size already occupied. + +If argument ON-LEFT is non-nil, we calculate to the left side. Otherwise, +calculate to the right side." + ;; XXX: We add up the `str-len' with `opposing-str-len' because they are using + ;; the same line! + ;; + ;; This is smart since we add up the string size before the calculation! + (setq str-len (+ str-len opposing-str-len)) + ;; Start the calculation! + (when-let* ((win-width (sideline--render-data :win-width)) + ((or (<= str-len win-width) + (sideline--exceed-display-p))) + (column-start (sideline--render-data :hscroll)) + (pos-end (ignore-errors (sideline--line-width))) + (pos-end (max pos-end column-start))) + (cond + (on-left + (let* ((pos-first (save-excursion (back-to-indentation) (current-column))) + ;; The variable `pos-first' cannot be lower than the `hscroll'. + (pos-first (max pos-first column-start)) + (remain-spaces (- pos-first column-start))) + (cond ((<= str-len remain-spaces) + (cons column-start pos-first)) + ((= pos-first pos-end) + (cons column-start win-width)) + ((and (sideline--exceed-display-p) + (< sideline--max-remain-spaces remain-spaces)) + (setq sideline--max-remain-spaces remain-spaces + sideline--max-remain-spaces-line (cons bol + (cons column-start pos-first))) + nil)))) ; Ensure return `nil'. + (t + (let* ((column-end (+ column-start win-width)) + (remain-spaces (- column-end pos-end))) + (cond ((<= str-len remain-spaces) + (cons column-end pos-end)) + ((and (sideline--exceed-display-p) + (< sideline--max-remain-spaces remain-spaces)) + (setq sideline--max-remain-spaces remain-spaces + sideline--max-remain-spaces-line (cons bol + (cons column-end pos-end))) + nil))))))) + +(defun sideline--find-line (str-len on-left &optional direction exceeded) + "Find a line where the string can be inserted. + +Argument STR-LEN is the length of the message, use to calculate the alignment. + +If argument ON-LEFT is non-nil, it will align to the left instead of right. + +See variable `sideline-order' document string for optional argument DIRECTION +for details. + +Optional argument EXCEEDED is set to non-nil when we have already searched +available lines in both directions (up & down)." + (let ((occupied-lines (if on-left sideline--occupied-lines-left + sideline--occupied-lines-right)) + (going-up (eq direction 'up)) + (skip-first t) + (break-it) + (data)) + (save-excursion + (while (not break-it) + (if skip-first (setq skip-first nil) + (forward-visible-line (if going-up -1 1))) + ;; Reach window edge, means find nothing. + (unless break-it + (unless (if going-up + (<= (sideline--render-data :win-start) (point)) + (<= (point) (sideline--render-data :win-end))) + (setq break-it t))) + ;; Reach buffer edge, means find nothing. + (unless break-it + (when (if going-up (bobp) (eobp)) + (setq break-it t))) + (when-let* + ((occ-bol (line-beginning-position)) + ((not (memq occ-bol occupied-lines))) + (col (or (sideline--calc-space str-len on-left + (sideline--opposing-str-len) + occ-bol) + ;; Handle exceed display. + (when (and exceeded ; after search on both sides. + break-it ; after reach edges. + sideline--max-remain-spaces-line) + ;; Apply to BOL + (setq occ-bol (car sideline--max-remain-spaces-line)) + (goto-char occ-bol) + ;; Return column data. + (cdr sideline--max-remain-spaces-line)))) + (pos-start (sideline--column-to-point (car col))) + (pos-end (sideline--column-to-point (cdr col))) + ((or on-left + ;; Skip virtual line from `truncate-lines'. + (= pos-start pos-end)))) + (setq data (list pos-start pos-end occ-bol)) + (setq break-it t) + (push occ-bol occupied-lines)))) + (if on-left + (setq sideline--occupied-lines-left occupied-lines) + (setq sideline--occupied-lines-right occupied-lines)) + (or data + (and (not exceeded) + (sideline--find-line str-len on-left (if going-up 'down 'up) t))))) + +(defun sideline--create-keymap (action candidate) + "Create keymap for sideline ACTION. + +Argument CANDIDATE is the data for users." + (let ((map (make-sparse-keymap))) + (define-key map [down-mouse-1] + (lambda () + (interactive) + (funcall action candidate))) + map)) + +;; +;; (@* "Overlays" ) +;; + +(defun sideline-backend-ovs (backend) + "Return overlays for BACKEND." + (sideline--overlays-in 'backend backend)) + +(defun sideline-delete-backend-ovs (backend) + "Delete overlays from BACKEND." + (dolist (ov (ht-get sideline--overlays backend)) + (let ((on-left (overlay-get ov 'left)) + (occ-pt (overlay-get ov 'occ-pt))) + (if on-left + (setq sideline--occupied-lines-left + (delete occ-pt sideline--occupied-lines-left)) + (setq sideline--occupied-lines-right + (delete occ-pt sideline--occupied-lines-right)))) + (delete-overlay ov)) + (ht-set sideline--overlays backend nil)) + +(defun sideline--reset-occupied-lines () + "Reset occupied lines." + (let ((mark (list (line-beginning-position)))) + (setq sideline--occupied-lines-left + (if sideline-backends-left-skip-current-line mark nil)) + (setq sideline--occupied-lines-right + (if sideline-backends-right-skip-current-line mark nil)))) + +(defun sideline--delete-ovs () + "Clean up all overlays." + (sideline--reset-occupied-lines) + (ht-map (lambda (_key value) + (mapc #'delete-overlay value)) + sideline--overlays) + (ht-clear sideline--overlays) + (ht-clear sideline--render-data-wapp)) + +(defun sideline--display-string (on-left backend-str candidate &optional type) + "Return the display string to render the text correctly. + +Argument ON-LEFT is used to calculate the output string. + +Arguments BACKEND-STR and CANDIDATE are used to string concatenation, it +produces the result string. + +Optional argument TYPE is used for recursive `outer' and `inner'." + (cl-case (or type sideline-display-backend-type) + (`left (concat backend-str " " candidate)) + (`right (concat candidate " " backend-str)) + (`inner (sideline--display-string on-left backend-str candidate (if on-left 'right 'left))) + (`outer (sideline--display-string on-left backend-str candidate (if on-left 'left 'right))))) + +(defun sideline--display-starting (on-left backend-str &optional type) + "Return the starting text position to render the text correctly. + +Argument ON-LEFT is used to calculate the starting text position.. + +Argument BACKEND-STR is used to calculate the starting text position. + +Optional argument TYPE is used for recursive `outer' and `inner'." + (cl-case (or type sideline-display-backend-type) + (`left (1+ (length backend-str))) + (`right 0) + (`inner (sideline--display-starting on-left backend-str (if on-left 'right 'left))) + (`outer (sideline--display-starting on-left backend-str (if on-left 'left 'right))))) + +(defun sideline--create-ov (backend candidate action face name on-left order) + "Create information (CANDIDATE) overlay. + +Argument BACKEND is used to categorize overlays. + +See function `sideline--render-candidates' document string for arguments ACTION, +FACE, NAME, ON-LEFT, and ORDER for details." + (when-let* + ((backend-str (format sideline-display-backend-format name)) + (text (if sideline-display-backend-name ; this is the displayed text + (progn + (add-face-text-property 0 (length backend-str) 'sideline-backend nil backend-str) + (sideline--display-string on-left backend-str candidate)) + candidate)) + (len-text (length text)) + (len-cand (length candidate)) + (title + (progn + (unless (get-text-property 0 'face candidate) ; If no face, we apply one + (let ((start (if sideline-display-backend-name + (sideline--display-starting on-left backend-str) + 0))) + (add-face-text-property start (+ start len-cand) face nil text))) + (when action ; apply action listener + (let ((keymap (sideline--create-keymap action candidate))) + (add-text-properties 0 len-text `(keymap ,keymap mouse-face highlight) text))) + (if on-left (format sideline-format-left text) + (format sideline-format-right text)))) + (len-title (sideline--str-len title)) + (data (let ((sideline--max-remain-spaces 0) ; Reset before use. + (sideline--max-remain-spaces-line nil)) ; Reset before use. + (sideline--find-line len-title on-left order))) + (pos-start (nth 0 data)) (pos-end (nth 1 data)) (occ-pt (nth 2 data)) + (hscroll (sideline--render-data :hscroll)) + (offset (- 0 hscroll)) + ;; Truncate + (title + (or (and sideline-truncate + (let* ((win-width (sideline--render-data :win-width)) + (end-col (save-excursion + (goto-char pos-end) + (current-column))) + (available-space (if on-left + (if (zerop end-col) + win-width + (- end-col hscroll 1)) + (- win-width (- end-col hscroll)))) + (suffix (copy-sequence (truncate-string-ellipsis)))) + (when (< available-space len-title) + (set-text-properties 0 (length suffix) + (text-properties-at (1- (length title)) title) + suffix) + (truncate-string-to-width title available-space 0 nil + suffix)))) + title)) + ;; Align left/right + (str (concat + (unless on-left + (propertize " " + 'display + `((space :align-to (- right ,(sideline--align-right title offset))) + (space :width 0)) + `cursor t)) + title))) + + ;; Create overlay + (let* ((len-str (length str)) + (left-empty-ln (= pos-start pos-end)) + (ov (make-overlay pos-start + (if left-empty-ln pos-start + ;; Cannot exceed `pos-end'. + (min pos-end (+ pos-start len-str))) + nil t t))) + (cond (on-left + (if left-empty-ln + (overlay-put ov 'before-string (concat (spaces-string hscroll) str)) + (overlay-put ov 'display str) + (overlay-put ov 'invisible t))) + (t (overlay-put ov 'before-string str))) + (overlay-put ov 'window (selected-window)) + (overlay-put ov 'priority (if on-left sideline-priority + ;; Add 1 to render on the same line! + (1+ sideline-priority))) + (overlay-put ov 'creator 'sideline) + (overlay-put ov 'backend backend) + (overlay-put ov 'on-left on-left) + (overlay-put ov 'occ-pt occ-pt) + (unless (gethash backend sideline--overlays) + (setf (gethash backend sideline--overlays) nil)) + (push ov (gethash backend sideline--overlays))))) + +;; +;; (@* "Async" ) +;; + +(defun sideline--guess-backend-name (backend) + "Guess BACKEND's name." + (let ((name (sideline-2str backend))) + (setq name (sideline--s-replace "sideline-" "" name) + name (sideline--s-replace "-sideline" "" name)) + name)) + +(defun sideline--render-candidates (candidates backend on-left order) + "Render a list of backends (CANDIDATES). + +Argument BACKEND is the backend symbol. + +Argument ON-LEFT is a flag indicates rendering alignment; if it's non-nil then +we align to the left, otherwise to the right. + +Argument ORDER determined the search order for going up or down." + (let ((inhibit-field-text-motion t) + (action (sideline--call-backend backend 'action)) + (face (or (sideline--call-backend backend 'face) 'sideline-default)) + (name (or (sideline--call-backend backend 'name) + (sideline--guess-backend-name backend)))) + (dolist (candidate candidates) + (sideline--create-ov backend candidate action face name on-left order)))) + +;; +;; (@* "Core" ) +;; + +(defvar-local sideline--backend-delay-timers nil + "Delay timer per backend.") + +(defun sideline--call-backend (backend command) + "Return BACKEND's result with COMMAND." + (funcall backend command)) + +(defun sideline--render-backend (backend on-left order) + "Render for single BACKEND. + +All arguments BACKEND, ON-LEFT and ORDER are extracted from the function +`sideline--render-backends'." + (when-let* ((candidates (sideline--call-backend backend 'candidates)) + (buffer (current-buffer))) ; for async check + (if (eq (car candidates) :async) + (funcall (cdr candidates) + (lambda (cands &rest _) + (sideline--with-buffer-window buffer + (when sideline-mode + ;; XXX: The bug occurs when you have two or more indentical + ;; windows (same buffer and same cursor position) and + ;; frequently change between different buffers. + ;; + ;; To solve this, just record the "real" rendering + ;; buffer in async. So when you switch back to the same + ;; buffer, the sideline can adjust to find the correct + ;; buffer in the function `sideline--do-render-p' since + ;; it has been flag here. + (setq sideline--ex-window (selected-window)) + (sideline--render-candidates cands backend on-left order))))) + (sideline--render-candidates candidates backend on-left order)))) + +(defun sideline--render-backends (backends on-left) + "Render a list of BACKENDS. + +If argument ON-LEFT is non-nil, it will align to the left +instead of right." + (dolist (data backends) + (let ((is-cons (consp data))) + (when-let* ((backend (if is-cons (car data) data)) + (backend (if (symbolp backend) backend + (eval backend))) + (order (if is-cons (cdr data) ; configured + ;; fallback to default + (if on-left sideline-order-left sideline-order-right)))) + ;; Handle backend delay here. + (if-let* ((delay (alist-get backend sideline-backend-delays))) + (progn + (sideline--kill-timer (ht-get sideline--backend-delay-timers backend)) + (ht-set sideline--backend-delay-timers + backend + (run-with-idle-timer delay nil #'sideline--render-backend + backend on-left order))) + (sideline--render-backend backend on-left order)))))) + +(defun sideline-stop-p () + "Return non-nil if the sideline should not be display." + (or (region-active-p) + (bound-and-true-p company-pseudo-tooltip-overlay) + (bound-and-true-p lsp-ui-peek--overlay))) + +(defun sideline--render-data (prop) + "Get render data by PROP." + (plist-get sideline--render-data prop)) + +(defun sideline--render-data-update (&rest _) + "Update the render data once." + (setq sideline--render-data + `( :win-end ,(sideline--window-end) + :win-start ,(window-start) + :hscroll ,(sideline--window-hscroll) + :win-width ,(sideline--window-width)))) + +(defun sideline-render (&optional buffer) + "Render sideline once in the BUFFER of WINDOW." + (sideline--with-buffer-window (or buffer (current-buffer)) + (unless (funcall sideline-inhibit-display-function) + (sideline--render-data-update) + (run-hooks 'sideline-pre-render-hook) + (sideline--render-backends sideline-backends-left t) + (sideline--render-backends sideline-backends-right nil) + (run-hooks 'sideline-post-render-hook)))) + +(defun sideline--do-render-p () + "Return non-nil if we should re-render sidelines in the post-command." + (let ((bound-or-point (or (bounds-of-thing-at-point 'symbol) + (point))) + (window (selected-window)) + (win-start (window-start)) + (win-hscroll (window-hscroll)) + (win-width (window-width)) + (win-height (window-height)) + (remapping-alist face-remapping-alist)) + (when ; conditions allow to re-render sidelines + (or (not (equal sideline--ex-bound-or-point bound-or-point)) + (not (equal sideline--text-scale-mode-amount text-scale-mode-amount)) + (not (equal sideline--ex-window window)) + (not (equal sideline--ex-window-start win-start)) + (not (equal sideline--ex-window-hscroll win-hscroll)) + (not (equal sideline--ex-window-width win-width)) + (not (equal sideline--ex-window-height win-height)) + (not (equal sideline--ex-face-remapping-alist remapping-alist)) + sideline-render-this-command) + ;; update + (setq sideline--ex-bound-or-point bound-or-point + sideline--text-scale-mode-amount text-scale-mode-amount + sideline--ex-window window + sideline--ex-window-start win-start + sideline--ex-window-hscroll win-hscroll + sideline--ex-window-width win-width + sideline--ex-window-height win-height + sideline--ex-face-remapping-alist remapping-alist + sideline-render-this-command nil) + t))) + +(defun sideline--before-revert (&rest _) + "Before revert." + (sideline--reset)) + +(defvar-local sideline--delay-timer nil + "Delay timer to render sideline.") + +(defun sideline--post-command () + "Post command." + (when (sideline--do-render-p) + (sideline--delete-ovs) + (sideline--kill-timer sideline--delay-timer) + (setq sideline--delay-timer + (run-with-idle-timer sideline-delay nil #'sideline-render + (current-buffer))) + ;; XXX: Reset hook can potentially re-render sideline; update the render + ;; data once to ensure display's correctioness. + (sideline--render-data-update) + (run-hooks 'sideline-reset-hook))) + +;;;###autoload +(defun sideline-render-this (&rest _) + "Use to force render the next post command." + (setq sideline-render-this-command t)) + +(defun sideline--reset () + "Clean up for next use." + (setq sideline--ex-bound-or-point nil) + (sideline--delete-ovs)) + +(provide 'sideline) +;;; sideline.el ends here |