Merge pull request #1423 from vindarel/legit-commits-log

legit: "l l" to show the commits log

with pagination

Author: vindarel

extensions/legit/README.md

@@ -85,6 +85,22 @@ You can push to the current remote branch with `P p` and pull changes (fetch) wi
 
 Note: after pressing "P" or "F", you will not see an intermediate window giving you choices. Just press "P p" one after the other.
 
+## Show commits log
+
+Press `l l` (lowercase "L", twice) to show the commits log in a dedicated buffer, with pagination.
+
+It defaults to showing the first 200 commits. Press `f` or `b` to see
+the next or the previous page of the commits history.
+
+Press `F` and `B` to go to the last or first page of commits.
+
+Configuration:
+
+- you can set `lem/porcelain:*commits-log-page-size*` to another length (defaults to 200).
+
+Note that going to the last page with `B` might take a few seconds on large repositories.
+
+
 ## Interactive rebase
 
 You can start a Git interactive rebase. Place the cursor on a commit you want to rebase from, and press `r i`.
@@ -217,7 +233,6 @@ Please report any bug, and please let's discuss before you open a Github issue f
 and then:
 
 - visual submenu to pick subcommands
-- view log
 - stage only selected region (more precise than hunks)
 - unstage/stage/discard multiple files
 - stashes

extensions/legit/legit.lisp

@@ -30,6 +30,7 @@ Done:
 - rebase interactively (see legit-rebase)
 - basic Fossil support (current branch, add change, commit)
 - basic Mercurial support
+- show the commits log, with pagination
 
 Ongoing:
 
@@ -79,6 +80,14 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
 (define-key lem/peek-legit:*peek-legit-keymap* "F p" 'legit-pull)
 (define-key *legit-diff-mode-keymap* "F p" 'legit-pull)
 
+;; commits log
+(define-key lem/peek-legit:*peek-legit-keymap* "l l" 'legit-commits-log)
+(define-key lem/peek-legit:*peek-legit-keymap* "f" 'legit-commits-log-next-page)
+(define-key lem/peek-legit:*peek-legit-keymap* "b" 'legit-commits-log-previous-page)
+(define-key lem/peek-legit:*peek-legit-keymap* "F" 'legit-commits-log-last-page)
+(define-key lem/peek-legit:*peek-legit-keymap* "B" 'legit-commits-log-first-page)
+(define-key *legit-diff-mode-keymap* "l l" 'legit-commits-log)
+
 ;; rebase
 ;;; interactive
 (define-key lem/peek-legit:*peek-legit-keymap* "r i" 'legit-rebase-interactive)
@@ -471,14 +480,14 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
                                 :stage-function (make-stage-function file)
                                 :unstage-function (make-unstage-function file :already-unstaged t)
                                 :discard-file-function (make-discard-file-function file))
-                       (insert-string point 
-                                      (format nil "~10a ~a" 
+                       (insert-string point
+                                      (format nil "~10a ~a"
                                               (case type
                                                 (:modified "modified")
                                                 (:deleted "deleted")
                                                 (t ""))
                                               file)
-                                      :attribute 'lem/peek-legit:filename-attribute 
+                                      :attribute 'lem/peek-legit:filename-attribute
                                       :read-only t)))
             (lem/peek-legit:collector-insert "<none>"))
 
@@ -495,15 +504,15 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
                                 :stage-function (make-stage-function file)
                                 :unstage-function (make-unstage-function file)
                                 :discard-file-function (make-discard-file-function file :is-staged t))
-                       (insert-string point 
-                                      (format nil "~10a ~a" 
+                       (insert-string point
+                                      (format nil "~10a ~a"
                                               (case type
                                                 (:modified "modified")
                                                 (:added "created")
                                                 (:deleted "deleted")
                                                 (t ""))
                                               file)
-                                      :attribute 'lem/peek-legit:filename-attribute 
+                                      :attribute 'lem/peek-legit:filename-attribute
                                       :read-only t)))
             (lem/peek-legit:collector-insert "<none>"))
 
@@ -621,6 +630,81 @@ Currently Git-only. Concretely, this calls Git with the -w option.")
   "Move point to the previous header of this VCS window."
   (lem/peek-legit:peek-legit-previous-header))
 
+(define-command legit-commits-log () ()
+  "List commits on a new buffer."
+  (with-current-project ()
+    (display-commits-log 0)))
+
+(defun display-commits-log (offset)
+  "Display the commit lines on a dedicated legit buffer."
+  (let* ((commits (lem/porcelain:commits-log :offset offset :limit lem/porcelain:*commits-log-page-size*)))
+    (lem/peek-legit:with-collecting-sources (collector :buffer :commits-log :read-only nil)
+      (lem/peek-legit:collector-insert
+       (format nil "Commits (~A):" offset)
+       :header t)
+      (if commits
+          (progn
+            (loop for commit in commits
+                  for line = nil
+                  for hash = nil
+                  for message = nil
+                  if (consp commit)
+                  do (setf line (getf commit :line)
+                           hash (getf commit :hash)
+                           message (getf commit :message))
+                  else
+                  do (setf line commit)
+                  do (lem/peek-legit:with-appending-source
+                         (point :move-function (make-show-commit-function hash)
+                                :visit-file-function (lambda ())
+                                :stage-function (lambda () )
+                                :unstage-function (lambda () ))
+                       (with-point ((start point))
+                         (when hash
+                           (insert-string point hash :attribute 'lem/peek-legit:filename-attribute :read-only t))
+                         (if message
+                             (insert-string point message)
+                             (insert-string point line))
+                         (when hash
+                           (put-text-property start point :commit-hash hash)))))
+            (setf (buffer-value (lem/peek-legit:collector-buffer collector) 'commits-offset) offset))
+          (lem/peek-legit:collector-insert "<no commits>")))))
+
+(define-command legit-commits-log-next-page () ()
+  "Show the next page of the commits log."
+  (with-current-project ()
+    (let* ((buffer (current-buffer))
+           (window-height (window-height (current-window)))
+           (current-offset (or (buffer-value buffer 'commits-offset) 0))
+           (new-offset (+ current-offset lem/porcelain:*commits-log-page-size*))
+           (commits (lem/porcelain:commits-log :offset new-offset
+                                               :limit lem/porcelain:*commits-log-page-size*)))
+      (if commits
+          (display-commits-log new-offset)
+          (message "No more commits to display.")))))
+
+(define-command legit-commits-log-previous-page () ()
+  "Show the previous page of the commits log."
+  (with-current-project ()
+    (let* ((buffer (current-buffer))
+           (window-height (window-height (current-window)))
+           (current-offset (or (buffer-value buffer 'commits-offset) 0))
+           (new-offset (max 0 (- current-offset lem/porcelain:*commits-log-page-size*))))
+      (display-commits-log new-offset))))
+
+(define-command legit-commits-log-first-page () ()
+  "Go to the first page of the commit log."
+  (with-current-project ()
+    (display-commits-log 0)))
+
+(define-command legit-commits-log-last-page () ()
+  "Go to the last page of the commit log."
+  (with-current-project ()
+    (let* ((commits-per-page lem/porcelain:*commits-log-page-size*)
+           (last-page-offset (* (floor (/ (1- (lem/porcelain:commit-count)) commits-per-page))
+                                commits-per-page)))
+      (display-commits-log last-page-offset))))
+
 (define-command legit-quit () ()
   "Quit"
   (lem/peek-legit:quit)

extensions/legit/peek-legit.lisp

@@ -234,27 +234,41 @@ Notes:
     (start-move-point (buffer-point (collector-buffer collector)))
     (show-matched-line)))
 
-(defun make-peek-legit-buffer ()
-  (let ((buffer (make-buffer "*peek-legit*"
+(defun make-peek-legit-buffer (&key (name "*peek-legit*"))
+  "Get or create a buffer of name NAME. By default, use a `*peek-legit*' buffer.
+  This is where we will display legit information (status…)."
+  (let ((buffer (make-buffer name
                              :temporary t
                              :enable-undo-p t
                              :directory (uiop:getcwd))))
     (setf (variable-value 'line-wrap :buffer buffer) nil)
     buffer))
 
-(defun call-with-collecting-sources (function &key read-only)
-  (let* ((*collector* (make-instance 'collector :buffer (make-peek-legit-buffer)))
+(defun call-with-collecting-sources (function &key read-only buffer )
+  "Initialize variables to display things on a legit buffer.
+
+  BUFFER: either :status or :commits-log.
+  READ-ONLY: boolean."
+  (let* ((*collector* (make-instance 'collector
+                                     :buffer
+                                     (make-peek-legit-buffer
+                                      :name
+                                      (case buffer
+                                        (:status "*peek-legit*")
+                                        (:commits-log "*legit-commits-log*")
+                                        (t (error "Unknown buffer name to display legit data: ~a" buffer))))))
          (point (buffer-point (collector-buffer *collector*))))
     (declare (ignorable point))
     (funcall function *collector*)
     (when read-only
       (setf (buffer-read-only-p (collector-buffer *collector*)) t))
       (display *collector*)))
 
-(defmacro with-collecting-sources ((collector &key (read-only t)) &body body)
+(defmacro with-collecting-sources ((collector &key (buffer :status) (read-only t)) &body body)
   `(call-with-collecting-sources (lambda (,collector)
                                    (declare (ignorable ,collector))
                                    ,@body)
+                                 :buffer ,buffer
                                  :read-only ,read-only))
 
 (defun call-with-appending-source (insert-function

extensions/legit/porcelain.lisp

@@ -1,5 +1,5 @@
 
-(defpackage :lem/porcelain
+(uiop:define-package :lem/porcelain
   (:use :cl)
   (:shadow :push)
   (:import-from :trivial-types
@@ -26,7 +26,9 @@
    :stage
    :unstage
    :vcs-project-p
-   )
+   :commits-log
+   :*commits-log-page-size*
+   :commit-count)
   (:documentation "Functions to run VCS operations: get the list of changes, of untracked files, commit, push… Git support is the main goal, a simple layer is used with other VCS systems (Fossil, Mercurial).
 
 On interactive commands, Legit will check what VCS is in use in the current project.
@@ -43,7 +45,7 @@ Supported version control systems:
 - Fossil: preliminary support
 - Mercurial: preliminary support
 
-TODOs: 
+TODOs:
 
 Mercurial:
 
@@ -67,6 +69,9 @@ Mercurial:
 (defvar *nb-latest-commits* 10
   "Number of commits to show in the status.")
 
+(defvar *commits-log-page-size* 200
+  "Number of commits to show in the commits log.")
+
 (defvar *branch-sort-by* "-creatordate"
   "When listing branches, sort by this field name.
   Prefix with \"-\" to sort in descending order.
@@ -470,8 +475,13 @@ allows to learn about the file state: modified, deleted, ignored… "
     (str:lines
      (run-git (list "log" "--pretty=oneline" "-n" (princ-to-string n))))))
 
-(defun git-latest-commits (&key (hash-length 8))
-  (let ((lines (%git-list-latest-commits)))
+(defun git-latest-commits (&key (n *commits-log-page-size*) (hash-length 8) (offset 0))
+  (let* ((n-arg (when n (list "-n" (princ-to-string n))))
+         (lines (str:lines
+                 (run-git (append (list "log"
+                                        "--pretty=oneline"
+                                        "--skip" (princ-to-string offset))
+                                  n-arg)))))
     (loop for line in lines
           for space-position = (position #\space line)
           for small-hash = (subseq line 0 hash-length)
@@ -480,8 +490,8 @@ allows to learn about the file state: modified, deleted, ignored… "
                         :message message
                         :hash small-hash))))
 
-(defun hg-latest-commits (&key (hash-length 8))
-  (declare (ignorable hash-length))
+(defun hg-latest-commits (&key (n *nb-latest-commits*) (hash-length 8))
+  (declare (ignorable n hash-length))
   (let ((out (run-hg "log")))
     ;; Split by paragraph.
         #| $ hg log
@@ -539,7 +549,7 @@ summary:     test
   ;; return bare result.
   (str:lines (run-fossil "timeline")))
 
-(defun latest-commits (&key (hash-length 8))
+(defun latest-commits (&key (n *nb-latest-commits*) (hash-length 8))
   "Return a list of strings or plists.
   The plist has a :hash and a :message, or simply a :line."
   (case *vcs*
@@ -548,7 +558,69 @@ summary:     test
     (:hg
      (hg-latest-commits))
     (t
-     (git-latest-commits :hash-length hash-length))))
+     (git-latest-commits :n n :hash-length hash-length))))
+
+(defun commits-log (&key (offset 0) limit (hash-length 8))
+  "Return a list of commits starting from the given offset.
+   If a limit is not provided, it returns all commits after the offset."
+  (case *vcs*
+    (:fossil
+     (fossil-commits-log :offset offset :limit limit :hash-length hash-length))
+    (:hg
+     (hg-commits-log :offset offset :limit limit :hash-length hash-length))
+    (:git
+     (git-commits-log :offset offset :limit limit :hash-length hash-length))
+    (t
+     (porcelain-error "Unknown VCS: ~a" *vcs*))))
+
+(defun git-commits-log (&key (offset 0) limit (hash-length 8))
+  (git-latest-commits :n limit
+                      :hash-length hash-length
+                      :offset offset))
+
+(defun hg-commits-log (&key (offset 0) limit (hash-length 8))
+  (declare (ignorable hash-length))
+  (let* ((commits (hg-latest-commits))
+         (total-commits (length commits))
+         (end (when limit
+                (min total-commits (+ offset limit)))))
+    (if (>= offset total-commits)
+        nil
+        (subseq commits offset end))))
+
+(defun fossil-commits-log (&key (offset 0) limit (hash-length 8))
+  (declare (ignorable hash-length))
+  (let* ((commits (fossil-latest-commits))
+         (total-commits (length commits))
+         (end (when limit (min total-commits (+ offset limit)))))
+    (if (>= offset total-commits)
+        nil
+        (subseq commits offset end))))
+
+(defun commit-count ()
+  "Get the total number of commits in the current branch."
+  (case *vcs*
+    (:git
+     (parse-integer
+      (str:trim (run-git '("rev-list" "--count" "HEAD")))))
+    (:hg
+     (parse-integer
+      (str:trim (run-hg '("id" "--num" "--rev" "tip")))))
+    (:fossil
+     (length))
+    (t
+     (porcelain-error "commit-count not implemented for VCS: ~a" *vcs*))))
+
+(defun %not-fossil-commit-line (line)
+  (str:starts-with-p "+++ no more data" line))
+
+(defun fossil-commit-count ()
+  ;; Not really tested in Lem.
+  (length
+   ;; Does the timeline command always end with "+++ no more data (1) +++" ?
+   (remove-if #'%not-fossil-commit-line
+              (str:lines
+               (run-fossil (list "timeline" "--oneline"))))))
 
 ;; stage, add files.
 (defun git-stage (file)