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: Thu, 09 Mar 2023 06:41:30 -0800 [thread overview]
Message-ID: <87ilfakmw5.fsf__29244.1518673272$1678372939$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: 47 bytes --]
v4. Push mark before moving in go-to command.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v3-v4.diff --]
[-- Type: text/x-patch, Size: 1720 bytes --]
From b375774e2f114ed5295e83ac31fe130a8b92aefa Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 9 Mar 2023 06:40:58 -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 | 167 ++++++++++++++++++++++++++++-
test/lisp/erc/erc-goodies-tests.el | 106 ++++++++++++++++++
2 files changed, 270 insertions(+), 3 deletions(-)
create mode 100644 test/lisp/erc/erc-goodies-tests.el
Interdiff:
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index b7f7214eed9..212e2e5340a 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -305,8 +305,11 @@ 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")))
+ (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)
diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el
index f08404be687..cd5e051ca63 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -46,6 +46,7 @@ erc-keep-place-indicator-mode
(should window-configuration-change-hook)
(should erc-keep-place-mode)))
;;
+ erc-insert-pre-hook
erc-modules)
(funcall assert-off)
--
2.39.2
[-- 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: 14561 bytes --]
From b375774e2f114ed5295e83ac31fe130a8b92aefa 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 (erc-keep-place-indicator-mode):
Add test.
(Bug#59943.)
---
lisp/erc/erc-goodies.el | 167 ++++++++++++++++++++++++++++-
test/lisp/erc/erc-goodies-tests.el | 106 ++++++++++++++++++
2 files changed, 270 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..212e2e5340a 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,154 @@ 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
+ (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))
@@ -168,6 +324,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..cd5e051ca63
--- /dev/null
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -0,0 +1,106 @@
+;;; 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-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
--
2.39.2
next prev parent reply other threads:[~2023-03-09 14:41 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.
2023-03-09 14:41 ` J.P. [this message]
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87ilfakmw5.fsf__29244.1518673272$1678372939$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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).