06/07: scripts: git: log: Add docstring.

[guix-commits]

magali pushed a commit to branch wip-guix-log
in repository guix.

commit b7428bcfd789747a397f1fd12b112566b1beeac0
Author: Magali Lemes <magalilemes00@gmail.com>
AuthorDate: Fri Jan 15 18:29:19 2021 -0300

    scripts: git: log: Add docstring.
    
    * guix/scripts/git/log.scm (%options, list-channels, 
information-placeholders,
    replace-regex, procedure-list, pretty-show-commit, show-channel-cache-path,
    show-commit, get-commits): Add docstring.
    * guix/scripts/git/log.scm: (%options, show-help): Add '--version'.
---
 guix/scripts/git/log.scm | 141 +++++++++++++++++++++++++++--------------------
 1 file changed, 82 insertions(+), 59 deletions(-)

diff --git a/guix/scripts/git/log.scm b/guix/scripts/git/log.scm
index 02876c7..afcf28b 100644
--- a/guix/scripts/git/log.scm
+++ b/guix/scripts/git/log.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Magali Lemes <magalilemes00@gmail.com>
+;;; Copyright © 2020, 2021 Magali Lemes <magalilemes00@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,10 +38,14 @@
   '("oneline" "medium" "full"))
 
 (define %options
+  ;; Specifications of the command-line options.
   (list (option '(#\h "help") #f #f
                 (lambda args
                   (show-help)
                   (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix git log")))
 
         (option '("channel-cache-path") #f #t
                 (lambda (opt name arg result)
@@ -65,6 +69,7 @@
   '())
 
 (define (list-channels)
+  "List channels and their checkout path"
   (define channels (channel-list '()))
   (for-each (lambda (channel)
               (format #t "~a~%  ~a~%"
@@ -84,8 +89,11 @@ Show Guix commit logs.\n"))
       --oneline          show short hash and summary of five first commits"))
   (display (G_ "
       --pretty=<string>  show log according to string"))
+  (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
   (newline)
   (show-bug-report-information))
 
@@ -94,25 +102,35 @@ Show Guix commit logs.\n"))
 
 (define placeholders-regex "%([Hhsb]|(an)|(cn))")
 
-(define information-placeholders `(("%b"  . ,commit-body)
-                                   ("%H"  . ,(compose oid->string commit-id))
-                                   ("%h"  . ,commit-short-id)
-                                   ("%s"  . ,commit-summary)
-                                   ("%an" . ,(compose signature-name 
commit-author))))
+(define information-placeholders
+  ;; Alist of placeholders and their corresponding procedure.
+  `(("%b"  . ,commit-body)
+    ("%H"  . ,(compose oid->string commit-id))
+    ("%h"  . ,commit-short-id)
+    ("%s"  . ,commit-summary)
+    ("%an" . ,(compose signature-name commit-author))))
 
 (define (replace-regex string)
+  "Return a string replacing all information placeholders with ~a"
   (regexp-substitute/global #f placeholders-regex string 'pre "~a" 'post))
 
 (define (procedure-list string)
+  "Return a list of procedures according to the placeholders contained in
+string, in the order they appear"
   (let* ((placeholders-in-the-string
           (map match:substring (list-matches placeholders-regex string))))
     (map (lambda (commit)
-           (assoc-ref information-placeholders commit)) 
placeholders-in-the-string)))
+           (assoc-ref information-placeholders commit))
+         placeholders-in-the-string)))
 
 (define (pretty-show-commit string commit)
-  (format #t "~?~%" (replace-regex string) (map (lambda (f) (f commit)) 
(procedure-list string))))
+  "Display commit according to string"
+  (format #t "~?~%" (replace-regex string) (map
+                                            (lambda (f) (f commit))
+                                            (procedure-list string))))
 
 (define (show-channel-cache-path channel)
+  "Display channel checkout path."
   (define channels (channel-list '()))
 
   (let ((found-channel (find (lambda (element)
@@ -122,61 +140,66 @@ Show Guix commit logs.\n"))
         (format #t "~a~%" (url-cache-directory (channel-url found-channel)))
         (leave (G_ "~a: channel not found~%") (symbol->string channel)))))
 
-;; --oneline = show-commit 'oneline #t
 (define (show-commit commit fmt abbrev-commit)
+  "Display commit according to fmt. If abbrev-commit is #t, then show short 
hash
+id instead of the 40-character one."
   (match fmt
-         ('oneline
-          (format #t "~a ~a~%"
-                  (if abbrev-commit
-                      (commit-short-id commit)
-                      (oid->string (commit-id commit)))
-                  (commit-summary commit)))
-         ('medium
-          (let ((author (commit-author commit))
-                (merge-commit (if (> (commit-parentcount commit) 1) #t #f)))
-            (format #t "commit ~a~[~%Merge:~]~{ ~a~}~%Author: ~a <~a>~%Date:   
~a~%~%~a~%"
-                    (if abbrev-commit
-                        (commit-short-id commit)
-                        (oid->string (commit-id commit)))
-                    (if merge-commit 0 1) ;; show "Merge:"
-                    (if merge-commit (map commit-short-id (commit-parents 
commit)) '())
-                    (signature-name  author)
-                    (signature-email author)
-                    (date->string
-                     (time-utc->date
-                      (make-time time-utc 0
-                                 (time-time (signature-when author)))
-                      (* 60 (time-offset (signature-when author))))
-                     "~a ~b ~e ~H:~M:~S ~Y ~z")
-                    (commit-message commit))))
-         ('full
-          (let ((merge-commit (if (> (commit-parentcount commit) 1) #t #f))
-                (author    (commit-author commit))
-                (committer (commit-committer commit)))
-            (format #t "commit ~a~[~%Merge:~]~{ ~a~}~%Author: ~a <~a>~%Commit: 
~a <~a>~%~%~a~%"
-                    (if abbrev-commit
-                        (commit-short-id commit)
-                        (oid->string (commit-id commit)))
-                    (if merge-commit 0 1) ;; show "Merge:"
-                    (if merge-commit (map commit-short-id (commit-parents 
commit)) '())
-                    (signature-name  author)
-                    (signature-email author)
-                    (signature-name  committer)
-                    (signature-email committer)
-                    (commit-message commit))))))
-
-;; returns a list with commits from all channels
+    ('oneline
+     (format #t "~a ~a~%"
+             (if abbrev-commit
+                 (commit-short-id commit)
+                 (oid->string (commit-id commit)))
+             (commit-summary commit)))
+    ('medium
+     (let ((author (commit-author commit))
+           (merge-commit (if (> (commit-parentcount commit) 1) #t #f)))
+       (format #t "commit ~a~[~%Merge:~]~{ ~a~}~%Author: ~a <~a>~%Date:   
~a~%~%~a~%"
+               (if abbrev-commit
+                   (commit-short-id commit)
+                   (oid->string (commit-id commit)))
+               (if merge-commit 0 1) ;; show "Merge:"
+               (if merge-commit (map commit-short-id (commit-parents commit)) 
'())
+               (signature-name  author)
+               (signature-email author)
+               (date->string
+                (time-utc->date
+                 (make-time time-utc 0
+                            (time-time (signature-when author)))
+                 (* 60 (time-offset (signature-when author))))
+                "~a ~b ~e ~H:~M:~S ~Y ~z")
+               (commit-message commit))))
+    ('full
+     (let ((merge-commit (if (> (commit-parentcount commit) 1) #t #f))
+           (author    (commit-author commit))
+           (committer (commit-committer commit)))
+       (format #t "commit ~a~[~%Merge:~]~{ ~a~}~%Author: ~a <~a>~%Commit: ~a 
<~a>~%~%~a~%"
+               (if abbrev-commit
+                   (commit-short-id commit)
+                   (oid->string (commit-id commit)))
+               (if merge-commit 0 1) ;; show "Merge:"
+               (if merge-commit (map commit-short-id (commit-parents commit)) 
'())
+               (signature-name  author)
+               (signature-email author)
+               (signature-name  committer)
+               (signature-email committer)
+               (commit-message commit))))))
+
+(define %channels-repositories
+  (make-hash-table))
+
 (define (get-commits)
+  "Return a list with commits from all channels."
   (define channels (channel-list '()))
 
   (fold (lambda (channel commit-list)
           (let* ((channel-path (url-cache-directory (channel-url channel)))
                  (repository (repository-open channel-path))
                  (latest-commit
-                  (commit-lookup repository (reference-target
-                                            (repository-head repository)))))
-            (append (set->list (commit-closure latest-commit))
-                    commit-list))) '() channels))
+                  (commit-lookup repository (object-id (revparse-single 
repository "origin/master")))))
+            (begin
+              (hashq-set! %channels-repositories channel-path repository)
+              (append (set->list (commit-closure latest-commit))
+                    commit-list)))) '() channels))
 
 (define (guix-git-log . args)
   (define options
@@ -193,11 +216,11 @@ Show Guix commit logs.\n"))
        (oneline?
         (for-each (lambda (commit-list)
                     (show-commit commit-list 'oneline #t))
-                  (take (get-commits) 5)))
+                  (get-commits)))
        (format-type
-        (for-each (lambda (commit-list)
-                    (show-commit commit-list format-type #f))
-                  (take (get-commits) 5)))
+          (for-each (lambda (commit-list)
+                      (show-commit commit-list format-type #f))
+                  (get-commits)))
        (pretty-string
         (let ((pretty-show (cut pretty-show-commit pretty-string <>)))
-          (for-each pretty-show (take (get-commits) 5))))))))
+          (for-each pretty-show (get-commits))))))))