tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

scripts: git: log: Add docstring.

Browse Source 
* 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'.
This commit is contained in:
Magali Lemes
2021-01-15 18:29:19 -03:00
committed by Ricardo Wurmus
parent b8270a11d6
commit 754157f50b
1 changed files with 81 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
guix/scripts/git/log.scm
View File

@@ -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))))))
('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))
;; returns a list with commits from all channels
(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))))))))