>From 6cc6dbbbb1e5add24bea2495cded7c2d5c5429f7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 20 Feb 2023 06:39:18 -0800 Subject: [PATCH 0/1] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (1): [5.6] Add option to show visual erc-keep-place indicator lisp/erc/erc-goodies.el | 164 ++++++++++++++++++++++++++++- test/lisp/erc/erc-goodies-tests.el | 105 ++++++++++++++++++ 2 files changed, 266 insertions(+), 3 deletions(-) create mode 100644 test/lisp/erc/erc-goodies-tests.el Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3f1f8cd157e..d5e256d9d33 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,16 +11,6 @@ This file is about changes in ERC, the powerful, modular, and extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. - -* Changes in ERC 5.6 - -** Module 'keep-place' now offers a visual indicator. - -Remember your place in ERC buffers a bit more easily while also having -the freedom to look around. Optionally sync the indicator to any -progress made when you haven't yet caught up to the live stream. See -new option 'erc-keep-place-indicator' and friends. - * Changes in ERC 5.5 diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 1c7c8f6a1be..b7f7214eed9 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -34,19 +34,24 @@ (eval-when-compile (require 'cl-lib)) (require 'erc-common) +(defvar erc--server-reconnecting) +(defvar erc--target) +(defvar erc--target-priors) (defvar erc-controls-highlight-regexp) (defvar erc-controls-remove-regexp) (defvar erc-input-marker) (defvar erc-insert-marker) -(defvar erc-server-process) -(defvar erc-modules) (defvar erc-log-p) +(defvar erc-modules) +(defvar erc-server-process) (declare-function erc-beg-of-input-line "erc" nil) -(declare-function erc-buffer-filter "erc" (predicate &optional proc)) (declare-function erc-buffer-list "erc" (&optional predicate proc)) +(declare-function erc-display-error-notice "erc" (parsed string)) (declare-function erc-error "erc" (&rest args)) (declare-function erc-extract-command-from-line "erc" (line)) + +(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)) @@ -157,18 +162,32 @@ erc-move-to-prompt-setup "Initialize the move-to-prompt module." (add-hook 'pre-command-hook #'erc-move-to-prompt nil t)) -(defcustom erc-keep-place-indicator nil - "Show kept place with visual indicator in target buffers. -For use with the `keep-place' module. A value of `arrow' -displays an arrow in the left fringe or margin. A value of -`face' applies `erc-keep-place-indicator-line' to the appropriate -line. A value of t does both. A value of nil does neither." +;;; Keep place in unvisited channels +(define-erc-module keep-place nil + "Leave point above un-viewed text in other channels." + ((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 nil) (const t) (const face) (const arrow))) + :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." + "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) @@ -181,7 +200,7 @@ erc-keep-place-indicator-line (supports :underline (:style wave))) (:underline (:color "PaleGreen1" :style wave))) (t :underline t)) - "Face for option `erc-keep-place-indicator'." + "Face for option `erc-keep-place-indicator-style'." :group 'erc-faces) (defface erc-keep-place-indicator-arrow @@ -190,82 +209,109 @@ erc-keep-place-indicator-arrow (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen1")) (t :inherit fringe)) - "Face for arrow value of option `erc-keep-place-indicator'." + "Face for arrow value of option `erc-keep-place-indicator-style'." :group 'erc-faces) -(defvar-local erc--keep-place-overlay nil - "Overlay for option `erc-keep-place-indicator'.") - -;; Replace this with whatever mechanism is devised for persisting -;; a target buffer's variables (if not limited to local modules) -(put 'erc--keep-place-overlay 'permanent-local t) +(defvar-local erc--keep-place-indicator-overlay nil + "Overlay for `erc-keep-place-indicator-mode'.") -(defun erc--keep-place-on-window-configuration-change () - "Maybe sync `erc--keep-place-overlay'. +(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-overlay) + (when (< (overlay-end erc--keep-place-indicator-overlay) (window-start) erc-insert-marker) (erc-keep-place-move (window-start)))))) -(defun erc--keep-place-setup-overlay () - (when erc-keep-place-indicator - (add-hook 'window-configuration-change-hook - #'erc--keep-place-on-window-configuration-change nil t) - (unless erc--keep-place-overlay - (setq erc--keep-place-overlay (make-overlay 0 0)) - (when (memq erc-keep-place-indicator '(t arrow)) - (overlay-put erc--keep-place-overlay 'before-string - (propertize - " " - 'display - (if (zerop (fringe-columns 'left)) - `((margin left-margin) ,overlay-arrow-string) - '(left-fringe right-triangle - erc-keep-place-indicator-arrow))))) - (when (memq erc-keep-place-indicator '(t face)) - (overlay-put erc--keep-place-overlay 'face - 'erc-keep-place-indicator-line))))) - -;;; Keep place in unvisited channels -(define-erc-module keep-place nil - "Leave point above un-viewed text in other channels." - ((add-hook 'erc-insert-pre-hook #'erc-keep-place) - (add-hook 'erc-mode-hook #'erc--keep-place-setup-overlay) - (erc-with-all-buffers-of-server erc-server-process nil - (erc--keep-place-setup-overlay))) - ((remove-hook 'erc-insert-pre-hook #'erc-keep-place) - (remove-hook 'erc-mode-hook #'erc--keep-place-setup-overlay) - (erc-with-all-buffers-of-server erc-server-process nil - (when erc--keep-place-overlay - (delete-overlay erc--keep-place-overlay) - (remove-hook 'window-configuration-change-hook - #'erc--keep-place-on-window-configuration-change t) - (kill-local-variable 'erc--keep-place-overlay))))) - -(defun erc-keep-place-move (&optional pos) - "Move keep-place indicator to the current line or POS." - (interactive) +(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-overlay + (move-overlay erc--keep-place-indicator-overlay (line-beginning-position) (line-end-position))))) (defun erc-keep-place-goto () - "Jump to keep-place indicator." - (interactive) - (goto-char (overlay-start erc--keep-place-overlay)) + "Jump to keep-place indicator. +For use with `keep-place-indicator' module." + (interactive + (unless erc-keep-place-indicator-mode + (user-error "`erc-keep-place-indicator-mode' not enabled"))) + (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-overlay))) + (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." @@ -275,11 +321,11 @@ erc-keep-place (deactivate-mark) (goto-char (erc-beg-of-input-line)) (forward-line -1) - (when erc-keep-place-indicator + (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))) + (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. diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el new file mode 100644 index 00000000000..f08404be687 --- /dev/null +++ b/test/lisp/erc/erc-goodies-tests.el @@ -0,0 +1,105 @@ +;;; erc-goodies-tests.el --- Tests for erc-goodies -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. +;; +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: +;;; Code: +(require 'ert-x) +(require 'erc) +(require 'erc-goodies) +(declare-function erc--initialize-markers "erc" (old-point continued) t) + +;; 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 () + (unless (fboundp 'erc--initialize-markers) + (ert-skip "Required patch set for bug#60954 not yet applied")) + (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-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 -- 2.39.1