diff options
| -rw-r--r-- | buildbot-client.el | 16 | ||||
| -rw-r--r-- | buildbot-utils.el | 53 | ||||
| -rw-r--r-- | buildbot-view.el | 102 |
3 files changed, 129 insertions, 42 deletions
diff --git a/buildbot-client.el b/buildbot-client.el index a633ff0..a1aa28b 100644 --- a/buildbot-client.el +++ b/buildbot-client.el @@ -35,7 +35,7 @@ (buildbot-url-fetch-raw (format "%s/api/v2/logs/%d/raw" buildbot-host logid))) -(defun buildbot-api-recent-changes (limit) +(defun buildbot-get-recent-changes (limit) (buildbot-api-change (list (cons 'order "-changeid") (cons 'limit limit)))) (defun buildbot-get-all-builders () @@ -53,11 +53,9 @@ (defun buildbot-get-builder-name-by-id (id) (alist-get 'name (buildbot-builder-by-id id))) -(defun buildbot-get-change-by-revision (revision) - (elt - (alist-get 'changes - (buildbot-api-change (list (cons 'revision revision)))) - 0)) +(defun buildbot-get-changes-by-revision (revision) + (alist-get 'changes + (buildbot-api-change (list (cons 'revision revision))))) (defun buildbot-get-build-by-buildid (buildid) (buildbot-api-build (list (cons 'buildid buildid)))) @@ -82,4 +80,10 @@ (defun buildbot-get-logs-by-stepid (stepid) (alist-get 'logs (buildbot-api-logs stepid))) +(defun buildbot-get-changes-by-branch (branch-name limit) + (alist-get 'changes + (buildbot-api-change + (cons `(branch . ,branch-name) + (when limit `((limit . ,limit))))))) + (provide 'buildbot-client) diff --git a/buildbot-utils.el b/buildbot-utils.el index d3b4a1e..e268e52 100644 --- a/buildbot-utils.el +++ b/buildbot-utils.el @@ -1,3 +1,4 @@ +;; -*- lexical-binding: t; -*- (defun buildbot-parse-http-header (text) (let ((status) (fields)) (with-temp-buffer @@ -86,4 +87,56 @@ 'failure) (t 'pending)))) +(defun buildbot-step-guess-status (step) + (let ((state (alist-get 'state_string step))) + (cond ((string-suffix-p "(warnings)" state) + 'pending) + ((string-suffix-p "(failure)" state) + 'failure) + ((string-suffix-p "done" state) + 'success) + ((string-suffix-p "ing" state) + 'pending) + ((string-suffix-p "finished" state) + 'success) + (t 'success)))) + +(defun buildbot-status-face (status) + (pcase status + ('success 'success) + ('failure 'error) + (_ 'warning))) + +(defun buildbot-get-build-stats (builds) + (let ((results (copy-tree '((success . 0) + (failure . 0) + (pending . 0)))) + (status)) + (seq-do + (lambda (build) + (setq status (buildbot-build-status build)) + (setf (alist-get status results) + (1+ (alist-get status results)))) + builds) + results)) + +(defun buildbot-get-info-and-builds (changes) + "Get revision-info and builds from a set of changes of the same revision. + +Concat all builds." + (let* ((builds (seq-mapcat + (lambda (change) + (alist-get 'builds change)) + changes)) + (first-change (elt changes 0)) + (info (list + (assq 'revision first-change) + (assq 'author first-change) + (cons 'created-at + (buildbot-format-epoch-time + (alist-get 'when_timestamp first-change))) + (assq 'comments first-change) + (cons 'build-stats (buildbot-get-build-stats builds))))) + `((revision-info . ,info) (builds . ,builds)))) + (provide 'buildbot-utils) diff --git a/buildbot-view.el b/buildbot-view.el index 12574cf..bacfe4a 100644 --- a/buildbot-view.el +++ b/buildbot-view.el @@ -2,6 +2,7 @@ (require 'buildbot-utils) (defvar buildbot-view-header-regex "^\\[.*\\]$") +(defvar buildbot-view-branch-change-limit 10) ;; 'revision, 'build, 'step, or 'log (defvar-local buildbot-view-type nil) (defvar-local buildbot-view-data nil) @@ -44,11 +45,17 @@ (alist-get 'failure stats) (alist-get 'pending stats))) +(defun buildbot-view-format-state-string (state-string) + (propertize state-string + 'face (buildbot-get-face-for-state-string (state-string)))) + (defun buildbot-view-format-build (build) (propertize - (format "\n[%s %s]\n%s" + (format "\n[%s | %s]\n%s" (buildbot-get-builder-name-by-id (alist-get 'builderid build)) - (alist-get 'state_string build) + (propertize (alist-get 'state_string build) + 'face (buildbot-status-face + (buildbot-build-status build))) (string-join (mapcar (lambda (test) (alist-get 'test_name test)) (alist-get 'failed_tests build)) @@ -57,10 +64,13 @@ (defun buildbot-view-format-step (step) (propertize - (format "\n[%d %s %s]\n" + (format "\n[%d. %s | %s]\n" (alist-get 'number step) (alist-get 'name step) - (alist-get 'state_string step)) + (propertize + (alist-get 'state_string step) + 'face (buildbot-status-face + (buildbot-step-guess-status step)))) 'step step 'type 'step)) (defun buildbot-view-format-log (log) @@ -77,28 +87,32 @@ (mapcar 'buildbot-view-format-build builds) "\n"))) -(defun buildbot-revision-get-info (change) - (list (cons 'revision (alist-get 'revision change)) - (cons 'author (alist-get 'author change)) - (cons 'created-at (buildbot-format-epoch-time - (alist-get 'created_at - (alist-get 'sourcestamp change)))) - (cons 'comments (alist-get 'comments change)) - (cons 'build-stats (buildbot-revision-get-build-stats - (alist-get 'builds change))))) - -(defun buildbot-revision-get-build-stats (builds) - (let ((results '((success . 0) - (failure . 0) - (pending . 0))) - status) - (seq-do - (lambda (build) - (setq status (buildbot-build-status build)) - (setf (alist-get status results) - (1+ (alist-get status results)))) - builds) - results)) +;; (defun buildbot-revision-get-info (change) +;; (list (cons 'revision (alist-get 'revision change)) +;; (cons 'author (alist-get 'author change)) +;; (cons 'created-at (buildbot-format-epoch-time +;; (alist-get 'when_timestamp change))) +;; (cons 'comments (alist-get 'comments change)) +;; (cons 'build-stats (buildbot-revision-get-build-stats +;; (alist-get 'builds change))))) + +(defun buildbot-view-format-branch (branch-name) + (propertize + (format "[Branch %s]" branch-name) + 'branch-name branch-name)) + +(defun buildbot-branch-format (branch-name changes) + (concat + (buildbot-view-format-branch branch-name) + "\n\n" + (string-join + (mapcar (lambda (change) + (buildbot-view-format-revision-info + (alist-get 'revision-info + (buildbot-get-info-and-builds + (list change))))) + changes) + "\n\n"))) (defun buildbot-build-format (revision-info build steps) (concat @@ -136,6 +150,7 @@ (defun buildbot-view-buffer-name (type data) (pcase type + ('branch (format "*buildbot branch %s*" (alist-get 'branch-name data))) ('revision (format "*buildbot revision %s*" (alist-get 'revision-id data))) ('build (format "*buildbot build %d*" @@ -162,7 +177,11 @@ (defun buildbot-view-revision-open (revision-id) (interactive "sRevision (commit hash): ") - (buildbot-view-load 'revision `((revision-id . ,revision-id)))) + (buildbot-view-open 'revision `((revision-id . ,revision-id)))) + +(defun buildbot-view-branch-open (branch-name) + (interactive "sBranch name: ") + (buildbot-view-open 'branch `((branch-name . ,branch-name)))) (defun buildbot-view-update () (unless (derived-mode-p 'buildbot-view-mode) @@ -170,15 +189,22 @@ (let ((inhibit-read-only t)) (erase-buffer) (pcase buildbot-view-type + ('branch + (insert (buildbot-branch-format + (alist-get 'branch-name buildbot-view-data) + (buildbot-get-changes-by-branch + (alist-get 'branch-name buildbot-view-data) + buildbot-view-branch-change-limit)))) ('revision - (let ((change - (buildbot-get-change-by-revision - (alist-get 'revision-id buildbot-view-data)))) + (let ((info-and-builds + (buildbot-get-info-and-builds + (buildbot-get-changes-by-revision + (alist-get 'revision-id buildbot-view-data))))) (setf (alist-get 'revision-info buildbot-view-data) - (buildbot-revision-get-info change)) + (alist-get 'revision-info info-and-builds)) (insert (buildbot-revision-format (alist-get 'revision-info buildbot-view-data) - (alist-get 'builds change))))) + (alist-get 'builds info-and-builds))))) ('build (insert (buildbot-build-format (alist-get 'revision-info buildbot-view-data) @@ -209,22 +235,26 @@ (interactive "P") (let ((data (copy-tree buildbot-view-data))) (pcase (get-text-property (point) 'type) + ('branch + (setf (alist-get 'branch-name data) + (get-text-property (point) 'branch-name)) + (buildbot-view-open 'branch data force)) ('revision (setf (alist-get 'revision-id data) (get-text-property (point) 'revision-id)) - (buildbot-view-open 'revision data)) + (buildbot-view-open 'revision data force)) ('build (setf (alist-get 'build data) (get-text-property (point) 'build)) - (buildbot-view-open 'build data)) + (buildbot-view-open 'build data force)) ('step (setf (alist-get 'step data) (get-text-property (point) 'step)) - (buildbot-view-open 'step data)) + (buildbot-view-open 'step data force)) ('log (setf (alist-get 'log data) (get-text-property (point) 'log)) - (buildbot-view-open 'log data))))) + (buildbot-view-open 'log data force))))) (define-key buildbot-view-mode-map (kbd "<return>") 'buildbot-view-open-thing-at-point) |