Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Add option to show visual erc-keep-place indicator

Browse source 
* lisp/erc/erc-goodies.el (erc-keep-place-indicator-style,
erc-keep-place-indicator-buffer-type,
erc-keep-place-indicator-follow): New options for anchoring kept place
visually.
(erc-keep-place-indicator-line, erc-keep-place-indicator-arrow): New
faces.
(erc--keep-place-indicator-overlay): New internal variable.
(erc--keep-place-indicator-on-window-configuration-change): New
function to subscribe to `window-configuration-change-hook' and maybe
update kept-place indicator.
(erc--keep-place-indicator-setup): New function to initialize buffer
for local module `keep-place-indicator'.
(erc-keep-place-indicator-mode, erc-keep-place-indicator-enable,
erc-keep-place-indicator-disable): New local ERC module.  Depends on
"parent" module `keep-place'.  Like `fill-wrap', this is (for now)
also deliberately left out of the widget menu for `erc-modules'.
(erc-keep-place-move, erc-keep-place-goto): Add new commands for
manually updating and jumping to keep-place indicator.
(erc-keep-place): Move `erc--keep-place-overlay' when applicable.
* test/lisp/erc/erc-goodies-tests.el (erc-keep-place-indicator-mode):
Add test.
(Bug#59943.)
This commit is contained in:
F. Jason Park 2022-12-09 22:00:59 -08:00
parent ba7fe88b78
commit e7992d2adb
2 changed files with 238 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

157
lisp/erc/erc-goodies.el
View file

@ -32,6 +32,10 @@
(eval-when-compile (require 'cl-lib))
(require 'erc)
(declare-function fringe-columns "fringe" (side &optional real))
(declare-function pulse-available-p "pulse" nil)
(declare-function pulse-momentary-highlight-overlay "pulse" (o &optional face))
;;; Automatically scroll to bottom
(defcustom erc-input-line-position nil
@ -143,6 +147,154 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
((add-hook 'erc-insert-pre-hook #'erc-keep-place))
((remove-hook 'erc-insert-pre-hook #'erc-keep-place)))
(defcustom erc-keep-place-indicator-style t
"Flavor of visual indicator applied to kept place.
For use with the `keep-place-indicator' module. A value of `arrow'
displays an arrow in the left fringe or margin. When it's
`face', ERC adds the face `erc-keep-place-indicator-line' to the
appropriate line. A value of t does both."
:group 'erc
:package-version '(ERC . "5.6")
:type '(choice (const t) (const server) (const target)))
(defcustom erc-keep-place-indicator-buffer-type t
"ERC buffer type in which to display `keep-place-indicator'.
A value of t means \"all\" ERC buffers."
:group 'erc
:package-version '(ERC . "5.6")
:type '(choice (const t) (const server) (const target)))
(defcustom erc-keep-place-indicator-follow nil
"Whether to sync visual kept place to window's top when reading.
For use with `erc-keep-place-indicator-mode'."
:group 'erc
:package-version '(ERC . "5.6")
:type 'boolean)
(defface erc-keep-place-indicator-line
'((((class color) (min-colors 88) (background light)
(supports :underline (:style wave)))
(:underline (:color "PaleGreen3" :style wave)))
(((class color) (min-colors 88) (background dark)
(supports :underline (:style wave)))
(:underline (:color "PaleGreen1" :style wave)))
(t :underline t))
"Face for option `erc-keep-place-indicator-style'."
:group 'erc-faces)
(defface erc-keep-place-indicator-arrow
'((((class color) (min-colors 88) (background light))
(:foreground "PaleGreen3"))
(((class color) (min-colors 88) (background dark))
(:foreground "PaleGreen1"))
(t :inherit fringe))
"Face for arrow value of option `erc-keep-place-indicator-style'."
:group 'erc-faces)
(defvar-local erc--keep-place-indicator-overlay nil
"Overlay for `erc-keep-place-indicator-mode'.")
(defun erc--keep-place-indicator-on-window-configuration-change ()
"Maybe sync `erc--keep-place-indicator-overlay'.
Specifically, do so unless switching to or from another window in
the active frame."
(when erc-keep-place-indicator-follow
(unless (or (minibuffer-window-active-p (minibuffer-window))
(eq (window-old-buffer) (current-buffer)))
(when (< (overlay-end erc--keep-place-indicator-overlay)
(window-start)
erc-insert-marker)
(erc-keep-place-move (window-start))))))
(defun erc--keep-place-indicator-setup ()
"Initialize buffer for maintaining `erc--keep-place-indicator-overlay'."
(require 'fringe)
(setq erc--keep-place-indicator-overlay
(if-let* ((vars (or erc--server-reconnecting erc--target-priors))
((alist-get 'erc-keep-place-indicator-mode vars)))
(alist-get 'erc--keep-place-indicator-overlay vars)
(make-overlay 0 0)))
(add-hook 'window-configuration-change-hook
#'erc--keep-place-indicator-on-window-configuration-change nil t)
(when-let* (((memq erc-keep-place-indicator-style '(t arrow)))
(display (if (zerop (fringe-columns 'left))
`((margin left-margin) ,overlay-arrow-string)
'(left-fringe right-triangle
erc-keep-place-indicator-arrow)))
(bef (propertize " " 'display display)))
(overlay-put erc--keep-place-indicator-overlay 'before-string bef))
(when (memq erc-keep-place-indicator-style '(t face))
(overlay-put erc--keep-place-indicator-overlay 'face
'erc-keep-place-indicator-line)))
;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies)
(define-erc-module keep-place-indicator nil
"`keep-place' with a fringe arrow and/or highlighted face."
((unless erc-keep-place-mode
(unless (memq 'keep-place erc-modules)
;; FIXME use `erc-button--display-error-notice-with-keys'
;; to display this message when bug#60933 is ready.
(erc-display-error-notice
nil (concat
"Local module `keep-place-indicator' needs module `keep-place'."
" Enabling now. This will affect \C-]all\C-] ERC sessions."
" Add `keep-place' to `erc-modules' to silence this message.")))
(erc-keep-place-mode +1))
(if (pcase erc-keep-place-indicator-buffer-type
('target erc--target)
('server (not erc--target))
('t t))
(erc--keep-place-indicator-setup)
(setq erc-keep-place-indicator-mode nil)))
((when erc--keep-place-indicator-overlay
(delete-overlay erc--keep-place-indicator-overlay)
(remove-hook 'window-configuration-change-hook
#'erc--keep-place-indicator-on-window-configuration-change t)
(kill-local-variable 'erc--keep-place-indicator-overlay)))
'local)
(defun erc-keep-place-move (pos)
"Move keep-place indicator to current line or POS.
For use with `keep-place-indicator' module. When called
interactively, interpret POS as an offset. Specifically, when
POS is a raw prefix arg, like (4), move the indicator to the
window's last line. When it's the minus sign, put it on the
window's first line. Interpret an integer as an offset in lines."
(interactive
(progn
(unless erc-keep-place-indicator-mode
(user-error "`erc-keep-place-indicator-mode' not enabled"))
(list (pcase current-prefix-arg
((and (pred integerp) v)
(save-excursion
(let ((inhibit-field-text-motion t))
(forward-line v)
(point))))
(`(,_) (1- (min erc-insert-marker (window-end))))
('- (min (1- erc-insert-marker) (window-start)))))))
(save-excursion
(let ((inhibit-field-text-motion t))
(when pos
(goto-char pos))
(move-overlay erc--keep-place-indicator-overlay
(line-beginning-position)
(line-end-position)))))
(defun erc-keep-place-goto ()
"Jump to keep-place indicator.
For use with `keep-place-indicator' module."
(interactive
(prog1 nil
(unless erc-keep-place-indicator-mode
(user-error "`erc-keep-place-indicator-mode' not enabled"))
(deactivate-mark)
(push-mark)))
(goto-char (overlay-start erc--keep-place-indicator-overlay))
(recenter (truncate (* (window-height) 0.25)) t)
(require 'pulse)
(when (pulse-available-p)
(pulse-momentary-highlight-overlay erc--keep-place-indicator-overlay)))
(defun erc-keep-place (_ignored)
"Move point away from the last line in a non-selected ERC buffer."
(when (and (not (eq (window-buffer (selected-window))
@ -151,6 +303,11 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
(deactivate-mark)
(goto-char (erc-beg-of-input-line))
(forward-line -1)
(when erc-keep-place-indicator-mode
(unless (or (minibuffer-window-active-p (selected-window))
(and (frame-visible-p (selected-frame))
(get-buffer-window (current-buffer) (selected-frame))))
(erc-keep-place-move nil)))
;; if `switch-to-buffer-preserve-window-point' is set,
;; we cannot rely on point being saved, and must commit
;; it to window-prev-buffers.

81
test/lisp/erc/erc-goodies-tests.el
View file

@ -250,4 +250,85 @@
(when noninteractive
(kill-buffer)))))
;; Among other things, this test also asserts that a local module's
;; minor-mode toggle is allowed to disable its mode variable as
;; needed.
(ert-deftest erc-keep-place-indicator-mode ()
;; FIXME remove after adding
(unless (fboundp 'erc--initialize-markers)
(ert-skip "Missing required function"))
(with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*")
(erc-mode)
(erc--initialize-markers (point) nil)
(let ((assert-off
(lambda ()
(should-not erc-keep-place-indicator-mode)
(should-not (local-variable-p 'window-configuration-change-hook))
(should-not erc--keep-place-indicator-overlay)))
(assert-on
(lambda ()
(should erc--keep-place-indicator-overlay)
(should (local-variable-p 'window-configuration-change-hook))
(should window-configuration-change-hook)
(should erc-keep-place-mode)))
;;
erc-insert-pre-hook
erc-modules)
(funcall assert-off)
(ert-info ("Value t")
(should (eq erc-keep-place-indicator-buffer-type t))
(erc-keep-place-indicator-mode +1)
(funcall assert-on)
(goto-char (point-min))
(should (search-forward "Enabling" nil t))
(should (memq 'keep-place erc-modules)))
(erc-keep-place-indicator-mode -1)
(funcall assert-off)
(ert-info ("Value `target'")
(let ((erc-keep-place-indicator-buffer-type 'target))
(erc-keep-place-indicator-mode +1)
(funcall assert-off)
(setq erc--target (erc--target-from-string "#chan"))
(erc-keep-place-indicator-mode +1)
(funcall assert-on)))
(erc-keep-place-indicator-mode -1)
(funcall assert-off)
(ert-info ("Value `server'")
(let ((erc-keep-place-indicator-buffer-type 'server))
(erc-keep-place-indicator-mode +1)
(funcall assert-off)
(setq erc--target nil)
(erc-keep-place-indicator-mode +1)
(funcall assert-on)))
;; Populate buffer
(erc-display-message nil 'notice (current-buffer)
"This buffer is for text that is not saved")
(erc-display-message nil 'notice (current-buffer)
"and for lisp evaluation")
(should (search-forward "saved" nil t))
(erc-keep-place-move nil)
(goto-char erc-input-marker)
(ert-info ("Indicator survives reconnect")
(let ((erc--server-reconnecting (buffer-local-variables)))
(cl-letf (((symbol-function 'erc-server-connect) #'ignore))
(erc-open "localhost" 6667 "tester" "Tester" 'connect
nil nil nil nil nil "tester" nil)))
(funcall assert-on)
(should (= (point) erc-input-marker))
(goto-char (overlay-start erc--keep-place-indicator-overlay))
(should (looking-at (rx "*** This buffer is for text")))))
(when noninteractive
(kill-buffer))))
;;; erc-goodies-tests.el ends here