all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "J.P." <jp@neverwas.me>
To: 59943@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#59943: 30.0.50; ERC 5.5+: Add visual indicator to ERC keep-place
Date: Mon, 20 Feb 2023 07:33:22 -0800	[thread overview]
Message-ID: <87k00ctkql.fsf__21004.3000684649$1676907257$gmane$org@neverwas.me> (raw)
In-Reply-To: <87fsdndzo1.fsf@neverwas.me> (J. P.'s message of "Sat, 10 Dec 2022 07:52:14 -0800")

[-- Attachment #1: Type: text/plain, Size: 310 bytes --]

v3. Convert to local module. Add option to discriminate on buffer type.

(This is meant to be applied atop bug#60954. The attached version has
been modified to apply cleanly on HEAD but is untested as such. See
https://emacs-erc.gitlab.io/bugs/49860/patches.tar.gz for the combined
set in its natural order.)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 17159 bytes --]

From 6cc6dbbbb1e5add24bea2495cded7c2d5c5429f7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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.
 
-\f
-* 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.
-
 \f
 * 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 <https://www.gnu.org/licenses/>.
+
+;;; 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Add-option-to-show-visual-erc-keep-place-indicat.patch --]
[-- Type: text/x-patch, Size: 14436 bytes --]

From 6cc6dbbbb1e5add24bea2495cded7c2d5c5429f7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 9 Dec 2022 22:00:59 -0800
Subject: [PATCH 1/1] [5.6] Add option to show visual erc-keep-place indicator

* 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: New file.
(Bug#59943.)
---
 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

diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 05a21019042..b7f7214eed9 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -34,18 +34,26 @@
 (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-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 erc-beg-of-input-line "erc" nil)
+
+(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))
 
 (defun erc-imenu-setup ()
   "Setup Imenu support in an ERC buffer."
@@ -160,6 +168,151 @@ keep-place
   ((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
+   (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-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))
@@ -168,6 +321,11 @@ erc-keep-place
     (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.
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 <https://www.gnu.org/licenses/>.
+
+;;; 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


  parent reply	other threads:[~2023-02-20 15:33 UTC|newest]

Thread overview: 8+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <87fsdndzo1.fsf@neverwas.me>
2022-12-16 14:26 ` bug#59943: 30.0.50; ERC 5.5+: Add visual indicator to ERC keep-place J.P.
     [not found] ` <87bko3jug8.fsf@neverwas.me>
2023-02-01  2:49   ` J.P.
2023-02-20 15:33 ` J.P. [this message]
2023-03-09 14:41 ` J.P.
2023-07-14  2:03 ` J.P.
2024-01-02 14:47 ` J.P.
2024-01-08  5:47   ` J.P.
2022-12-10 15:52 J.P.

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='87k00ctkql.fsf__21004.3000684649$1676907257$gmane$org@neverwas.me' \
    --to=jp@neverwas.me \
    --cc=59943@debbugs.gnu.org \
    --cc=emacs-erc@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.