diff options
Diffstat (limited to 'lisp/erc/erc-stamp.el')
| -rw-r--r-- | lisp/erc/erc-stamp.el | 239 |
1 files changed, 205 insertions, 34 deletions
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 0aa1590f801..61f289a8753 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -55,6 +55,9 @@ If nil, timestamping is turned off." :type '(choice (const nil) (string))) +;; FIXME remove surrounding whitespace from default value and have +;; `erc-insert-timestamp-left-and-right' add it before insertion. + (defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" "If set to a string, messages will be timestamped. This string is processed using `format-time-string'. @@ -68,7 +71,7 @@ If nil, timestamping is turned off." :type '(choice (const nil) (string))) -(defcustom erc-timestamp-format-right " [%H:%M]" +(defcustom erc-timestamp-format-right nil "If set to a string, messages will be timestamped. This string is processed using `format-time-string'. Good examples are \"%T\" and \"%H:%M\". @@ -77,9 +80,14 @@ This timestamp is used for timestamps on the right side of the screen when `erc-insert-timestamp-function' is set to `erc-insert-timestamp-left-and-right'. -If nil, timestamping is turned off." +Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if +the value of this option is nil, it falls back to using the value +of `erc-timestamp-format'." + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) (string))) +(make-obsolete-variable 'erc-timestamp-format-right + 'erc-timestamp-format "30.1") (defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right "Function to use to insert timestamps. @@ -147,39 +155,67 @@ from entering them and instead jump over them." "ERC timestamp face." :group 'erc-faces) +;; New libraries should only autoload the minor mode for a module's +;; preferred name (rather than its alias). + +;;;###autoload(put 'timestamp 'erc--module 'stamp) ;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec) (add-hook 'erc-insert-modify-hook #'erc-add-timestamp t) - (add-hook 'erc-send-modify-hook #'erc-add-timestamp t)) + (add-hook 'erc-send-modify-hook #'erc-add-timestamp t) + (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)) ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) - (remove-hook 'erc-send-modify-hook #'erc-add-timestamp))) + (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) + (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect))) + +(defun erc-stamp--recover-on-reconnect () + (when-let ((priors (or erc--server-reconnecting erc--target-priors))) + (dolist (var '(erc-timestamp-last-inserted + erc-timestamp-last-inserted-left + erc-timestamp-last-inserted-right)) + (when-let (existing (alist-get var priors)) + (set var existing))))) + +(defvar erc-stamp--current-time nil + "The current time when calling `erc-insert-timestamp-function'. +Specifically, this is the same lisp time object used to create +the stamp passed to `erc-insert-timestamp-function'.") + +(cl-defgeneric erc-stamp--current-time () + "Return a lisp time object to associate with an IRC message. +This becomes the message's `erc-timestamp' text property, which +may not be unique, `equal'-wise." + (erc-current-time)) + +(cl-defmethod erc-stamp--current-time :around () + (or erc-stamp--current-time (cl-call-next-method))) (defun erc-add-timestamp () "Add timestamp and text-properties to message. This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (get-text-property (point) 'invisible) - (let ((ct (current-time))) - (if (fboundp erc-insert-timestamp-function) - (funcall erc-insert-timestamp-function - (erc-format-timestamp ct erc-timestamp-format)) - (error "Timestamp function unbound")) + (unless (get-text-property (point-min) 'invisible) + (let* ((ct (erc-stamp--current-time)) + (erc-stamp--current-time ct)) + (funcall erc-insert-timestamp-function + (erc-format-timestamp ct erc-timestamp-format)) + ;; FIXME this will error when advice has been applied. (when (and (fboundp erc-insert-away-timestamp-function) erc-away-timestamp-format (erc-away-time) (not erc-timestamp-format)) (funcall erc-insert-away-timestamp-function (erc-format-timestamp ct erc-away-timestamp-format))) - (add-text-properties (point-min) (point-max) + (add-text-properties (point-min) (1- (point-max)) ;; It's important for the function to ;; be different on different entries (bug#22700). (list 'cursor-sensor-functions - (list (lambda (_window _before dir) - (erc-echo-timestamp dir ct)))))))) + ;; Regions are no longer contiguous ^ + '(erc--echo-ts-csf) 'erc-timestamp ct))))) (defvar-local erc-timestamp-last-window-width nil "The width of the last window that showed the current buffer. @@ -217,14 +253,113 @@ 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) + (when (eq (current-buffer) (window-buffer)) + (set-window-margins nil left-margin-width width)))) + +;;;###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 + (setq fringes-outside-margins t) + (when (eq (current-buffer) (window-buffer)) + (set-window-buffer (selected-window) (current-buffer))) + (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 'fringes-outside-margins) + (when (eq (current-buffer) (window-buffer)) + (set-window-margins nil left-margin-width nil) + (set-window-buffer (selected-window) (current-buffer))))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." @@ -243,6 +378,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 " ") @@ -253,6 +389,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 @@ -304,30 +442,57 @@ 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 (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) -(defun erc-insert-timestamp-left-and-right (_string) - "This is another function that can be used with `erc-insert-timestamp-function'. -If the date is changed, it will print a blank line, the date, and -another blank line. If the time is changed, it will then print -it off to the right." - (let* ((ct (current-time)) - (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) - (ts-right (erc-format-timestamp ct erc-timestamp-format-right))) +(defvar erc-stamp--insert-date-function #'insert + "Function to insert left \"left-right date\" stamp. +A local module might use this to modify text properties, +`insert-before-markers' or renarrow the region after insertion.") + +(defun erc-insert-timestamp-left-and-right (string) + "Insert a stamp on either side when it changes. +When the deprecated option `erc-timestamp-format-right' is nil, +use STRING, which originates from `erc-timestamp-format', for the +right-hand stamp. Use `erc-timestamp-format-left' for the +left-hand stamp and expect it to change less frequently." + (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + (ts-right (with-suppressed-warnings + ((obsolete erc-timestamp-format-right)) + (if erc-timestamp-format-right + (erc-format-timestamp ct erc-timestamp-format-right) + string)))) ;; insert left timestamp (unless (string-equal ts-left erc-timestamp-last-inserted-left) (goto-char (point-min)) (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) - (insert ts-left) + (funcall erc-stamp--insert-date-function ts-left) (setq erc-timestamp-last-inserted-left ts-left)) ;; insert right timestamp (let ((erc-timestamp-only-if-changed-flag t) @@ -336,12 +501,13 @@ it off to the right." (setq erc-timestamp-last-inserted-right ts-right)))) ;; for testing: (setq erc-timestamp-only-if-changed-flag nil) +(defvar erc-stamp--tz nil) (defun erc-format-timestamp (time format) "Return TIME formatted as string according to FORMAT. Return the empty string if FORMAT is nil." (if format - (let ((ts (format-time-string format time))) + (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) @@ -400,11 +566,16 @@ enabled when the message was inserted." (defun erc-echo-timestamp (dir stamp) "Print timestamp text-property of an IRC message." - (when (and erc-echo-timestamps (eq 'entered dir)) + ;; Could also pass an &optional `zone' arg to `format-time-string'. + (interactive (list 'entered (get-text-property (point) 'erc-timestamp))) + (when (eq 'entered dir) (when stamp (message "%s" (format-time-string erc-echo-timestamp-format stamp))))) +(defun erc--echo-ts-csf (_window _before dir) + (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp))) + (provide 'erc-stamp) ;;; erc-stamp.el ends here |