diff --git a/README.org b/README.org index 15c5334..dfb936e 100644 --- a/README.org +++ b/README.org @@ -14,6 +14,10 @@ The message formatting is customizeable (e.g. the timestamp can be displayed in [[images/screenshot2.png]] +Timestamp headers are displayed where a certain amount of time passes between events. + +[[images/screenshot3.png]] + * Contents :noexport: :PROPERTIES: :TOC: :include siblings diff --git a/ement-room.el b/ement-room.el index fe57d3a..e755e72 100644 --- a/ement-room.el +++ b/ement-room.el @@ -133,6 +133,12 @@ See Info node `(elisp)Other Display Specs'." (function :tag "Function") (sexp :tag "Form"))) )) +(defcustom ement-room-timestamp-header-delta 600 + "Show timestamp header where events are at least this many seconds apart." + :type 'integer) + +;;;;; Faces + (defface ement-room-membership '((t (:inherit font-lock-comment-face))) "Membership events (join/part).") @@ -153,6 +159,10 @@ See Info node `(elisp)Other Display Specs'." '((t (:inherit font-lock-variable-name-face))) "Own messages.") +(defface ement-room-timestamp-header + '((t (:inherit header-line :weight bold))) + "Timestamp headers.") + ;;;; Commands (defun ement-room-goto-prev (num) @@ -216,7 +226,8 @@ See Info node `(elisp)Other Display Specs'." ((map _start end chunk state) data) (buffer (cl-loop for buffer in (buffer-list) when (equal room (buffer-local-value 'ement-room buffer)) - return buffer))) + return buffer)) + (window) (point-node) (orig-first-node)) ;; FIXME: These are pushed onto the front of the lists. Doesn't ;; really matter, but maybe better to put them at the other end. (cl-loop for event across state @@ -227,15 +238,19 @@ See Info node `(elisp)Other Display Specs'." (push event (ement-room-timeline room))) (when buffer (with-current-buffer buffer - (when-let* ((window (get-buffer-window buffer)) - (point-node (with-selected-window window - (ewoc-locate ement-ewoc (window-start))))) - (cl-loop for event across chunk - do (ement-room--insert-event event)) - (with-selected-window (get-buffer-window buffer) - (set-window-start nil (ewoc-location point-node)) - ;; FIXME: Experiment with this. - (forward-line -1))) + (setf window (get-buffer-window buffer) + point-node (when window + (with-selected-window window + (ewoc-locate ement-ewoc (window-start)))) + orig-first-node (ewoc-nth ement-ewoc 0)) + (cl-loop for event across chunk + do (ement-room--insert-event event)) + ;; Insert timestamp headers up to the original first node. + (ement-room--insert-ts-headers nil orig-first-node) + (with-selected-window (get-buffer-window buffer) + (set-window-start nil (ewoc-location point-node)) + ;; FIXME: Experiment with this. + (forward-line -1)) (setf (ement-room-prev-batch room) end ement-room-retro-loading nil))))) @@ -295,7 +310,7 @@ and erases the buffer." left-margin-width ement-room-left-margin-width right-margin-width ement-room-right-margin-width ;; TODO: Use EWOC header/footer for, e.g. typing messages. - ement-ewoc (ewoc-create #'ement-room--pp-event))) + ement-ewoc (ewoc-create #'ement-room--pp-thing))) (defun ement-room--buffer (session room name) "Return a buffer named NAME showing ROOM's events on SESSION." @@ -311,6 +326,8 @@ and erases the buffer." ;; Move new events to main list. (setf (ement-room-timeline room) (append (ement-room-timeline* room) (ement-room-timeline room)) (ement-room-timeline* room) nil) + ;; Insert timestamp headers. + (ement-room--insert-ts-headers) ;; Return the buffer! (current-buffer)))) @@ -331,6 +348,38 @@ and erases the buffer." ;;;;; EWOC +(defun ement-room--ewoc-next-matching (ewoc node pred) + "Return the next node in EWOC after NODE that matches PRED." + ;; MAYBE: Make the next/prev fn an arg. + (cl-loop do (setf node (ewoc-next ewoc node)) + until (or (null node) + (funcall pred (ewoc-data node))) + finally return node)) + +(defun ement-room--insert-ts-headers (&optional start-node end-node) + "Insert timestamp headers into current buffer." + (ignore start-node end-node) + (let* ((ewoc ement-ewoc) + (end-pos (ewoc-location (or end-node + (ewoc-nth ewoc -1)))) + (node-b (or start-node (ewoc-nth ewoc 0))) + node-a) + (while (and (setf node-a (ement-room--ewoc-next-matching ewoc node-b #'ement-event-p) + node-b (when node-a + (ement-room--ewoc-next-matching ewoc node-a #'ement-event-p))) + (not (or (>= (ewoc-location node-a) end-pos) + (>= (ewoc-location node-b) end-pos)))) + ;; NOTE: Matrix timestamps are in milliseconds. + (let* ((a-ts (/ (ement-event-origin-server-ts (ewoc-data node-a)) 1000)) + (b-ts (/ (ement-event-origin-server-ts (ewoc-data node-b)) 1000)) + (diff-seconds (- b-ts a-ts))) + (when (and (>= diff-seconds ement-room-timestamp-header-delta) + (not (when-let ((node-after-a (ewoc-next ewoc node-a))) + (pcase (ewoc-data node-after-a) + (`(ts) t))))) + (ewoc-enter-after ewoc node-a + (list 'ts b-ts))))))) + (defun ement-room--insert-event (event) "Insert EVENT into current buffer." (let* ((ewoc ement-ewoc) @@ -372,9 +421,20 @@ and erases the buffer." (ewoc-enter-before ewoc new-node (ement-event-sender event))) (ement-debug "Event before: compare sender.") (if (equal (ement-event-sender event) - (cl-typecase (ewoc-data node-before) - (ement-event (ement-event-sender (ewoc-data node-before))) - (ement-user (ewoc-data node-before)))) + (pcase-exhaustive (ewoc-data node-before) + ((pred ement-event-p) + (ement-event-sender (ewoc-data node-before))) + ((pred ement-user-p) + (ewoc-data node-before)) + (`(ts ,(pred numberp)) + ;; Timestamp header. + (when-let ((node-before-ts (ewoc-prev ewoc node-before))) + ;; FIXME: Well this is ugly. Make a filter predicate or something. + (pcase-exhaustive (ewoc-data node-before-ts) + ((pred ement-event-p) + (ement-event-sender (ewoc-data node-before))) + ((pred ement-user-p) + (ewoc-data node-before))))))) (ement-debug "Same sender.") (ement-debug "Different sender: insert new sender node.") (ewoc-enter-before ewoc new-node (ement-event-sender event)) @@ -418,13 +478,21 @@ and erases the buffer." ;;;;; Formatting -(defun ement-room--pp-event (struct) - "Pretty-print STRUCT. -To be used as the pretty-printer for `ewoc-create'." - (cl-etypecase struct - (ement-event (insert "" (ement-room--format-event struct))) - (ement-user (insert (propertize (ement-room--format-user struct) - 'display ement-room-username-display-property))))) +(defun ement-room--pp-thing (thing) + "Pretty-print THING. +To be used as the pretty-printer for `ewoc-create'. THING may be +an `ement-event' or `ement-user' struct, or a list like `(ts +TIMESTAMP)', where TIMESTAMP is a Unix timestamp number of +seconds." + (pcase-exhaustive thing + ((pred ement-event-p) + (insert "" (ement-room--format-event thing))) + ((pred ement-user-p) + (insert (propertize (ement-room--format-user thing) + 'display ement-room-username-display-property))) + (`(ts ,(and (pred numberp) ts)) ;; Insert a date header. + (insert "\n" (propertize (format-time-string " %H:%M\n" ts) + 'face 'ement-room-timestamp-header))))) ;; (defun ement-room--format-event (event) ;; "Format `ement-event' EVENT." diff --git a/ement.el b/ement.el index e7d3b5f..99489d6 100644 --- a/ement.el +++ b/ement.el @@ -6,7 +6,7 @@ ;; Keywords: comm ;; URL: https://github.com/alphapapa/ement.el ;; Package-Version: 0.1-pre -;; Package-Requires: ((emacs "26.3") (plz "0.1-pre") (ts "0.2")) +;; Package-Requires: ((emacs "26.3") (plz "0.1-pre")) ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/images/screenshot3.png b/images/screenshot3.png new file mode 100644 index 0000000..5d11958 Binary files /dev/null and b/images/screenshot3.png differ