pestctrl/emacs
1
0
Fork 0
forked from Github/emacs
Code Issues Pull requests Projects Releases Packages Wiki Activity

Put display properties to better use in erc-stamp

Browse source 
* lisp/erc/erc-log.el (erc-log-filter-function): Add new value
`erc-stamp-prefix-log-filter'.
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-hand
stamps.  Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--adjust-right-margin): New function to adjust width of
right margin.
(erc-stamp-prefix-log-filter): New value for `erc-log-filter-function'
compatible with modules that activate
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure left-right, display-prop-oriented stamps
are showing correctly.  Does not support left-hand-only stamps.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-stamp--inherited-props): Add internal constant to hold properties
that should be inherited from any stamp-bearing message being
inserted.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests.  (Bug#60936.)
This commit is contained in:
F. Jason Park 2021-11-24 05:35:35 -08:00
parent 379d35695b
commit 9f6a9cef97
3 changed files with 191 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lisp/erc/erc-log.el
View file

@ -198,6 +198,7 @@ This should ideally, be a \"catch-all\" coding system, like
The function should take one argument, which is the text to filter."
:type '(choice (function "Function")
(function-item erc-stamp-prefix-log-filter)
(const :tag "No filtering" nil)))

136
lisp/erc/erc-stamp.el
View file

@ -253,14 +253,110 @@ the correct column."
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
(defcustom erc-timestamp-use-align-to (eq window-system 'x)
(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
A side effect of enabling this is that there will only be one
space before a right timestamp in any saved logs."
:type 'boolean)
This option only matters when `erc-insert-timestamp-function' is
set to `erc-insert-timestamp-right' or that option's default,
`erc-insert-timestamp-left-and-right'. If the value is a
positive integer, alignment occurs that many columns from the
right edge. If the value is `margin', the stamp appears in the
right margin when visible.
Enabling this option produces a side effect in that stamps aren't
indented in saved logs. When its value is an integer, this
option adds a space after the end of a message if the stamp
doesn't already start with one. And when its value is t, it adds
a single space, unconditionally. And while this option never
adds a space when its value is `margin', ERC does offer a
workaround in `erc-stamp-prefix-log-filter', which strips
trailing stamps from messages and puts them before every line."
:type '(choice boolean integer (const margin))
:package-version '(ERC . "5.6")) ; FIXME sync on release
(defcustom erc-stamp-right-margin-width nil
"Width in columns of the right margin.
When this option is nil, pretend its value is one column greater
than the `string-width' of the formatted `erc-timestamp-format'.
This option only matters when `erc-timestamp-use-align-to' is set
to `margin'."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) integer))
(defun erc-stamp--display-margin-force (orig &rest r)
(let ((erc-timestamp-use-align-to 'margin))
(apply orig r)))
(defun erc-stamp--adjust-right-margin (cols)
"Adjust right margin by COLS.
When COLS is zero, reset width to `erc-stamp-right-margin-width'
or one col more than the `string-width' of
`erc-timestamp-format'."
(let ((width
(if (zerop cols)
(or erc-stamp-right-margin-width
(1+ (string-width (or erc-timestamp-last-inserted-right
(erc-format-timestamp
(current-time)
erc-timestamp-format)))))
(+ right-margin-width cols))))
(setq right-margin-width width
right-fringe-width 0)
(set-window-margins nil left-margin-width width)
(set-window-fringes nil left-fringe-width 0)))
;;;###autoload
(defun erc-stamp-prefix-log-filter (text)
"Prefix every message in the buffer with a stamp.
Remove trailing stamps as well. For now, hard code the format to
\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
`erc-log-filter-function' when `erc-timestamp-use-align-to' is
non-nil."
(insert text)
(goto-char (point-min))
(while
(progn
(when-let* (((< (point) (pos-eol)))
(end (1- (pos-eol)))
((eq 'erc-timestamp (field-at-pos end)))
(beg (field-beginning end))
;; Skip a line that's just a timestamp.
((> beg (point))))
(delete-region beg (1+ end)))
(when-let (time (get-text-property (point) 'erc-timestamp))
(insert (format-time-string "[%H:%M:%S] " time)))
(zerop (forward-line))))
"")
(declare-function erc--remove-text-properties "erc" (string))
;; If people want to use this directly, we can convert it into
;; a local module.
(define-minor-mode erc-stamp--display-margin-mode
"Internal minor mode for built-in modules integrating with `stamp'.
It binds `erc-timestamp-use-align-to' to `margin' around calls to
`erc-insert-timestamp-function' in the current buffer, and sets
the right window margin to `erc-stamp-right-margin-width'. It
also arranges to remove most text properties when a user kills
message text so that stamps will be visible when yanked."
:interactive nil
(if erc-stamp--display-margin-mode
(progn
(erc-stamp--adjust-right-margin 0)
(add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
(add-function :around (local 'erc-insert-timestamp-function)
#'erc-stamp--display-margin-force))
(remove-function (local 'filter-buffer-substring-function)
#'erc--remove-text-properties)
(remove-function (local 'erc-insert-timestamp-function)
#'erc-stamp--display-margin-force)
(kill-local-variable 'right-margin-width)
(kill-local-variable 'right-fringe-width)
(set-window-margins nil left-margin-width nil)
(set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@ -279,6 +375,7 @@ space before a right timestamp in any saved logs."
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
(declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@ -289,6 +386,8 @@ property to get to the POSth column."
;; Silence byte-compiler
(defvar erc-fill-column)
(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@ -340,12 +439,29 @@ printed just after each line's text (no alignment)."
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
(if (< col pos)
(erc-insert-aligned string pos)
(newline)
(indent-to pos)
(setq from (point))
(insert string))
;; For compatibility reasons, the `erc-timestamp' field includes
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
((pred integerp) ; (cl-type (integer 0 *))
(insert " ")
(when (eq ?\s (aref string 0))
(setq string (substring string 1)))
(let ((s (+ erc-timestamp-use-align-to (string-width string))))
(put-text-property from (point) 'display
`(space :align-to (- right ,s)))))
('margin
(put-text-property 0 (length string)
'display `((margin right-margin) ,string)
string))
((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
(_ (indent-to pos)))
(insert string)
(dolist (p erc-stamp--inherited-props)
(when-let ((v (get-text-property (1- from) p)))
(put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible

70
test/lisp/erc/erc-stamp-tests.el
View file

@ -68,7 +68,7 @@
(erc-display-message nil 'notice (current-buffer) "begin"))
(goto-char (point-min))
(should (search-forward-regexp
(rx "begin" (+ "\t") (* " ") " [") nil t))
(rx "begin" (+ "\t") (* " ") "[") nil t))
;; Field includes intervening spaces
(should (eql ?n (char-before (field-beginning (point)))))
;; Timestamp extends to the end of the line
@ -85,9 +85,9 @@
(erc-timestamp-right-column 20))
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
(should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
(should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@ -101,7 +101,7 @@
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Exactly two spaces, one from format, one added by erc-stamp.
(should (search-forward "msg one [" nil t))
(should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
@ -112,9 +112,67 @@
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; Indented to pos (this is arguably a bug).
(should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
(should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field starts *after* leading space (arguably bad).
(should (eql ?\[ (char-after (1+ (field-beginning (point))))))
(should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--integer ()
(erc-stamp-tests--insert-right
(lambda ()
(ert-info ("integer, normal")
(let ((erc-timestamp-use-align-to 1))
(let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Space not added because included in format string.
(should (search-forward "msg one [" nil t))
;; Field covers space between.
(should (eql ?e (char-before (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point))))))
(ert-info ("integer, overlong (hard wrap)")
(let ((erc-timestamp-use-align-to 1)
(erc-timestamp-right-column 20))
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; No hard wrap
(should (search-forward "oooo [" nil t))
;; Field starts at leading space.
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--margin ()
(erc-stamp-tests--insert-right
(lambda ()
(erc-stamp--display-margin-mode +1)
(ert-info ("margin, normal")
(let ((erc-timestamp-use-align-to 'margin))
(let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
(put-text-property 0 (length msg) 'wrap-prefix 10 msg)
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
;; Space not added (treated as opaque string).
(should (search-forward "msg one[" nil t))
;; Field covers stamp alone
(should (eql ?e (char-before (field-beginning (point)))))
;; Vanity props extended
(should (get-text-property (field-beginning (point)) 'wrap-prefix))
(should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
(should (get-text-property (1- (field-end (point))) 'wrap-prefix))
(should (eql ?\n (char-after (field-end (point))))))
(ert-info ("margin, overlong (hard wrap)")
(let ((erc-timestamp-use-align-to 'margin)
(erc-timestamp-right-column 20))
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
;; No hard wrap
(should (search-forward "oooo[" nil t))
;; Field starts at format string (right bracket)
(should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting