timeline.el

;; -*- lexical-binding: t -*-


;; timeline-mode minor mode records and shows a timeline of buffer
;; changes
;;
;; Buffer changes are stored after using complex commands and after
;; every save
;; 
;; Changes are processed after 5 seconds of idleness, so that
;; processing does not interfere with typing
;;
;; Command timeline-show shows the timeline with a complex command
;; name or compressed diff shown beside every item and a full diff in
;; an other window for the currently selected item
;;


(require 'map)
(require 'diff)

;; number of timeline item stored for a file
(setq timeline-max-stored-items 50)

;; do not store diffs for files bigger than this to avoid
;; unnecessarily processing large data files, for example
(setq timeline-max-file-size 100000)

;; idle delay before putting new items on the timeline
(setq timeline-idle-second-before-processing-changes 5)


(setq timeline-pending-changes nil)


(defun timeline-process-changes ()
  (while (and timeline-pending-changes
              (not (input-pending-p)))
    (let* ((change (prog1
                       (car (last timeline-pending-changes))
                     (setq timeline-pending-changes (nbutlast timeline-pending-changes))))
           (oldbuf (with-current-buffer (get-buffer-create "*timeline-prev*")
                     (erase-buffer)
                     (insert (plist-get change 'text-before))
                     (current-buffer)))
           (newbuf (with-current-buffer (get-buffer-create "*timeline-new*")
                     (erase-buffer)
                     (insert (plist-get change 'text-after))
                     (current-buffer))))

      (with-current-buffer (plist-get change 'buffer)
        (let ((diff (with-temp-buffer
                      (diff-no-select oldbuf newbuf
                                      nil t (current-buffer))
                      (goto-char (point-min))
                      (forward-line 1)
                      (let ((start (point)))
                        (goto-char (point-max))
                        (forward-line -1)
                        (if (looking-at "Diff finished\\.")
                            (buffer-substring start (point)))))))

          (when diff
            (if (buffer-file-name)
                (setq diff (replace-regexp-in-string
                            (format "#<buffer %s>"
                                    (regexp-quote (buffer-name newbuf)))
                            (buffer-file-name)
                            diff)))
            
            (push (map-delete (map-delete (plist-put change 'diff diff)
                                          'text-after)
                              'text-before)
                  timeline-items)

            (kill-buffer oldbuf)
            (kill-buffer newbuf)

            (if (> (length timeline-items)
                   timeline-max-stored-items)
                (setq timeline-items
                      (butlast timeline-items))))
          )))))


(defun timeline-show ()
  (interactive)
  (unless (bound-and-true-p timeline-items)
    (error "no stored diffs for this file"))
  
  (setq timeline-previous-window-cfg
        (current-window-configuration))

  (let* ((command-face 'font-lock-function-name-face)
         (items (mapcar
                 (lambda (item)
                   (list nil (vconcat
                              (list (propertize
                                     (plist-get item 'time)
                                     'face 'line-number)
                                    
                                    (propertize
                                     (if (plist-get item 'command)
                                         (propertize (format
                                                      "%S"
                                                      (plist-get item 'command))
                                                     
                                                     'face command-face)

                                       (with-temp-buffer
                                         (insert (plist-get item 'diff))
                                         (goto-char (point-min))
                                         (search-forward "@@")

                                         (let ((text "")
                                               firstchar)
                                           (while (and (< (length text) 100)
                                                       (re-search-forward "^[-+]" nil t))
                                             (setq firstchar (match-string 0))
                                             (setq text
                                                   (concat
                                                    text
                                                    (propertize
                                                     (concat
                                                      " "
                                                      (string-trim
                                                       (replace-regexp-in-string
                                                        "  +" " "
                                                        (buffer-substring
                                                         (point)
                                                         (line-end-position)))))

                                                     'face
                                                     (if (equal firstchar "+")
                                                         'diff-added
                                                       'diff-removed)))))
                                           text)))
                                     
                                     'timeline-data
                                     item)))))
                 timeline-items)))

    (define-derived-mode timeline-list-mode tabulated-list-mode "timeline-list-mode"
      "Major mode for tabulated list."
      (setq tabulated-list-format [("Time" 16)
                                   ("Change Description" 0)])
      (setq tabulated-list-entries items)
      (tabulated-list-init-header)
      (tabulated-list-print t))
    
    (pop-to-buffer "*timeline items*")
    (timeline-list-mode)

    (local-set-key "q" (lambda ()
                         (interactive)
                         (set-window-configuration timeline-previous-window-cfg)))
    
    (local-set-key (kbd "<return>")
                   (lambda ()
                     (interactive)
                     (pop-to-buffer "*timeline diff*")))
    (add-hook 'post-command-hook  'timeline-show-diff nil t)
    (setq timeline-diffs-current-line nil)))





(defun timeline-show-diff ()
  (interactive)
  (if (and (not (eq timeline-diffs-current-line (line-number-at-pos)))
           (sit-for 0.3))
      (let ((data (get-text-property (1- (line-end-position)) 'timeline-data)))
        (if data
            (save-selected-window
              (pop-to-buffer "*timeline diff*")
              (let ((inhibit-read-only t))
                (erase-buffer)
                (unless (eq major-mode 'diff-mode)
                  (diff-mode))
                (save-excursion
                  (insert (plist-get data 'diff))))
              (read-only-mode 1)))

        (setq timeline-diffs-current-line (line-number-at-pos)))))


(define-minor-mode timeline-mode
  "Timeline for buffer."
  :lighter " Timeline"

  
  (if timeline-mode
      (progn
        (if (> (buffer-size) timeline-max-file-size)
            (progn
              (setq timeline-mode nil)
              (message "File size is over the limit for timeline."))

          (unless (boundp 'timeline-process-changes-timer)
            (setq timeline-process-changes-timer
                  (run-with-idle-timer
                   timeline-idle-second-before-processing-changes
                   t
                   'timeline-process-changes)))
          
          (make-local-variable 'timeline-items)
          (unless (boundp 'timeline-items)
            (setq timeline-items nil))

          (make-local-variable 'timeline-last-known-text)
          (setq timeline-last-known-text (buffer-string))

          (make-local-variable 'timeline-last-known-tick)
          (setq timeline-last-known-tick (buffer-chars-modified-tick))))))


(defun timeline-check-manual-edits (&optional arg)
  (when (and (bound-and-true-p timeline-mode)
             (not (eq timeline-last-known-tick (buffer-chars-modified-tick))))
    (timeline-add-item-for-processing
     nil
     timeline-last-known-text
     (setq timeline-last-known-text (buffer-string)))
    
    (setq timeline-last-known-tick (buffer-chars-modified-tick))))


(advice-add 'save-buffer :after 'timeline-check-manual-edits)


;; advise add-to-history to catch complex commands
(defun timeline-add-to-history (history-var newelt &optional maxelt keep-all)
  (when (and (eq history-var 'command-history)
             (bound-and-true-p timeline-mode))
    (setq timeline-current-command newelt)
    (setq timeline-buffer-text-before-command nil)
    (add-hook 'before-change-functions 'timeline-before-change nil t)
    (add-hook 'post-command-hook 'timeline-post-command)))


(advice-add 'add-to-history :after 'timeline-add-to-history)
;;(advice-remove 'add-to-history 'timeline-add-to-history)


;; if the buffer is modified during the command then store the
;; previous buffer text before the first modification
(defun timeline-before-change (beg end)
  (setq timeline-buffer-text-before-command (buffer-string))
  (remove-hook 'before-change-functions 'timeline-before-change t)

  (unless (eq timeline-last-known-tick (buffer-chars-modified-tick))
    (timeline-add-item-for-processing
     nil
     timeline-last-known-text
     timeline-buffer-text-before-command)))


;; if there was a modification then store change info for processing
;; later
(defun timeline-post-command ()
  (when timeline-buffer-text-before-command
    (setq timeline-last-known-text (buffer-string))
    (setq timeline-last-known-tick (buffer-chars-modified-tick))

    (timeline-add-item-for-processing
     timeline-current-command
     timeline-buffer-text-before-command
     timeline-last-known-text))
  
  (remove-hook 'before-change-functions 'timeline-before-change t)
  (remove-hook 'post-command-hook 'timeline-post-command))


(defun timeline-add-item-for-processing (command text-before text-after)
  (push (list 'buffer (current-buffer)
              'command command
              'text-before text-before
              'text-after text-after
              'time (format-time-string "%Y-%m-%d %H:%M"))
        timeline-pending-changes))


(provide 'timeline)