diff options
| -rw-r--r-- | guix/scripts/git/log.scm | 141 |
1 files changed, 82 insertions, 59 deletions
diff --git a/guix/scripts/git/log.scm b/guix/scripts/git/log.scm index 02876c763f..afcf28b285 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)))))))) |