branch: master commit cfa7c4eab13e07177a9ad5e2e164aaca693e0930 Author: Tino Calancha <tino.calan...@gmail.com> Commit: Tino Calancha <tino.calan...@gmail.com>
Add missing file gited-ci.el * packages/gited/gited-ci.el: New file. * packages/gited/Makefile: Load gited-ci as well. * packages/gited/gited.el: Bump version to 0.5.2. * packages/gited/gited-ci-tests.el (gited-ci-load): New test. --- packages/gited/Makefile | 2 +- packages/gited/gited-ci.el | 224 ++++++++++++++++++++++++++++++++++++++++++ packages/gited/gited-tests.el | 164 +++++++++++++++++++------------ packages/gited/gited.el | 4 +- 4 files changed, 326 insertions(+), 68 deletions(-) diff --git a/packages/gited/Makefile b/packages/gited/Makefile index 68f1376..11cf46c 100644 --- a/packages/gited/Makefile +++ b/packages/gited/Makefile @@ -1,6 +1,6 @@ emacs ?= emacs -LOAD = -l gited.el +LOAD = -l gited-ci.el -l gited.el all: test diff --git a/packages/gited/gited-ci.el b/packages/gited/gited-ci.el new file mode 100644 index 0000000..cf0f311 --- /dev/null +++ b/packages/gited/gited-ci.el @@ -0,0 +1,224 @@ +;;; gited-ci.el --- Obtain CI status of the trunk branch -*- lexical-binding:t -*- +;; +;; Filename: gited-ci.el +;; Description: Obtain CI status of the trunk branch +;; +;; Author: Tino Calancha <tino.calan...@gmail.com> +;; Maintainer: Tino Calancha <tino.calan...@gmail.com> +;; URL: https://github.com/calancha/Gited +;; Copyright (C) 2016-2018, Tino Calancha, all rights reserved. +;; + +;;; Commentary: +;; + +;; +;; Internal variables defined here: +;; +;; `gited-last-trunk-commit', `gited-trunk-ci-status', +;; `gited-trunk-ci-status-fail-face', `gited-trunk-ci-status-pending-face', +;; `gited-trunk-ci-status-running-face', +;; `gited-trunk-ci-status-success-face', +;; `gited-trunk-ci-status-unknown-face'. +;; +;; Coustom variables defined here: +;; +;; `gited-show-trunk-ci-status'. +;; +;; Non-interactive functions defined here: +;; +;; `gited--show-trunk-ci-status', `gited--trunk-ci-status', +;; `gited-parse-ci-status', `gited-pull-callback', +;; `gited-trunk-ci-last-commit-uri', `gited-trunk-ci-status'. +;; +;; Faces defined here: +;; +;; `gited-trunk-ci-status-fail', `gited-trunk-ci-status-pending', +;; `gited-trunk-ci-status-running', `gited-trunk-ci-status-success', +;; `gited-trunk-ci-status-unknown'. +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This file is NOT part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + + + +;; TODO: Support more CI services. +(defcustom gited-show-trunk-ci-status nil + "Show CI status for the last commit in the trunk branch. +An alist of conses ((TOPLEVEL_DIR_1 . CI-URI_1) (TOPLEVEL_DIR_2 . CI-URI_2) ... ). +TOPLEVEL_DIR_I is the toplevel directory for the ith local Git repository. +CI_URI_I is the URI to access the Continous Integration system. +Supported CI are Gitlab, Travis and CircleCI: for Gitlab, you need to provide +all but the commit hash, for instance, in the case of the Emacs Gitlab CI, +the value is +`https://gitlab.com/emacs-ci/emacs/commit/'. +For Travis, the format is as follows: +`https://api.travis-ci.org/calancha/Gited.svg?branch=master'. +For circleci: +`https://circleci.com/gh/calancha/foo/tree/master'." + :type '(repeat + (choice + (cons :tag "Show trunk CI status" + (string :tag "gited-toplevel-dir" :value "") + (string :tag "gited-ci-uri" :value "")))) + :group 'gited) + +(defvar-local gited-trunk-ci-status nil + "Status of the last commit in the trunk branch for the CI.") +(put 'gited-trunk-ci-status 'permanent-local t) + +(defface gited-trunk-ci-status-fail + '((t (:foreground "Red"))) + "Face for trunk branch with last commit fail in the CI." + :group 'gited :group 'font-lock-highlighting-faces) +(defvar gited-trunk-ci-status-fail-face 'gited-trunk-ci-status-fail) + +(defface gited-trunk-ci-status-running + '((t (:foreground "LightSkyBlue"))) + "Face for trunk branch with last commit running in the CI." + :group 'gited :group 'font-lock-highlighting-faces) +(defvar gited-trunk-ci-status-running-face 'gited-trunk-ci-status-running) + +(defface gited-trunk-ci-status-success + '((((background dark)) (:foreground "green")) + (t (:foreground "white" :background "forest green"))) + "Face for trunk branch with last commit succeded in the CI." + :group 'gited :group 'font-lock-highlighting-faces) +(defvar gited-trunk-ci-status-success-face 'gited-trunk-ci-status-success) + +(defface gited-trunk-ci-status-unknown + '((((background dark)) (:foreground "orange")) + (t (:foreground "black"))) + "Face for trunk branch with last commit status in the CI unknown." + :group 'gited :group 'font-lock-highlighting-faces) +(defvar gited-trunk-ci-status-unknown-face 'gited-trunk-ci-status-unknown) + +(defface gited-trunk-ci-status-pending + '((((background dark)) (:foreground "hotpink")) + (t (:foreground "deeppink"))) + "Face for trunk branch with last commit status in the CI pending." + :group 'gited :group 'font-lock-highlighting-faces) +(defvar gited-trunk-ci-status-pending-face 'gited-trunk-ci-status-pending) + +(defun gited-parse-ci-status (&rest args) + "Parse the status of the trunk last commit in the Gitlab CI. +`gited-buffer' is passed as the last element of ARGS list." + (goto-char 1) + (let* ((toplevel-dir (with-current-buffer (car (last args)) + gited-toplevel-dir)) + (ci-uri (cdr (assoc toplevel-dir gited-show-trunk-ci-status))) + (success-regexp + (cond ((string-match "gitlab" ci-uri) "ci-status-icon-success") + ((string-match "\\(travis-ci\\)\\|\\(circleci\\)" ci-uri) "passing"))) + (failed-regexp + (cond ((string-match "gitlab" ci-uri) "ci-status-icon-failed") + ((string-match "travis-ci" ci-uri) "failed") + ((string-match "circleci" ci-uri) "failing"))) + (pending-regexp + (cond ((string-match "gitlab" ci-uri) "ci-status-icon-pending") + ((string-match "travis-ci" ci-uri) "pending") + ((string-match "circleci" ci-uri) "pending"))) + (running-regexp + (cond ((string-match "gitlab" ci-uri) "ci-status-icon-running") + ((string-match "\\(travis-ci\\)\\|\\(circleci\\)" ci-uri) "running"))) ; This one always fail + (ci-status + (cond ((save-excursion + (re-search-forward success-regexp nil t)) + 'success) + ((save-excursion + (re-search-forward failed-regexp nil t)) + 'failed) + ((save-excursion + (re-search-forward running-regexp nil t)) + 'running) + ((save-excursion + (re-search-forward pending-regexp nil t)) + 'pending) + (t 'unknown)))) + (message "Parse CI status done!") + ;; Show the staus in the Gited buffer. + (with-current-buffer (car (last args)) + (setq gited-trunk-ci-status ci-status) + (gited--show-trunk-ci-status)))) + +(declare-function gited--last-trunk-commit "gited.el") + +(defun gited-trunk-ci-last-commit-uri () + (let ((ci-uri (cdr (assoc gited-toplevel-dir gited-show-trunk-ci-status)))) + (cond ((string-match "\\(travis-ci\\)\\|\\(circleci\\)" ci-uri) ci-uri) + ((string-match "gitlab" ci-uri) + (format "%s%s" ci-uri (gited--last-trunk-commit))) + (t (user-error "Dont know this CI service uri '%s'" ci-uri))))) + +(defun gited--trunk-ci-status () + "Return the status of the Gitlab CI for the last commit in the trunk branch." + (let ((url (gited-trunk-ci-last-commit-uri))) + (url-retrieve url 'gited-parse-ci-status (list gited-buffer)))) + +(defun gited-trunk-ci-status () + "Return the status of the CI for the last commit in the trunk branch." + (unless (derived-mode-p 'gited-mode) (user-error "Not a Gited buffer")) + (gited--trunk-ci-status)) + +(defun gited--show-trunk-ci-status () + (save-excursion + (gited-goto-branch (gited-trunk-branch)) + (gited--move-to-column (1+ gited-commit-idx)) + (let ((inhibit-read-only t)) + (let* ((start (point)) + (end (point-at-eol)) + (status-face + (cond ((eq gited-trunk-ci-status 'success) + 'gited-trunk-ci-status-success) + ((eq gited-trunk-ci-status 'failed) + 'gited-trunk-ci-status-fail) + ((eq gited-trunk-ci-status 'running) + 'gited-trunk-ci-status-running) + ((eq gited-trunk-ci-status 'pending) + 'gited-trunk-ci-status-pending) + (t + 'gited-trunk-ci-status-unknown)))) + (put-text-property start end 'face status-face) + (put-text-property + start end 'help-echo (format "CI status %S: %s" + gited-trunk-ci-status + (gited-trunk-ci-last-commit-uri))))))) + + +(defvar-local gited-last-trunk-commit "" "Last commit hash in trunk branch.") +(put 'gited-last-trunk-commit 'permanent-local t) + +;; Update trunk CI status if `gited-show-trunk-ci-status' is non-nil +;; and we have fetched new commits from the trunk branch. +(defun gited-pull-callback () + "Run `gited-trunk-ci-status' after remote fetching or reverting buffer." + (when (and gited-show-trunk-ci-status + (car-safe (assoc gited-toplevel-dir gited-show-trunk-ci-status)) + (equal (directory-file-name (car (assoc gited-toplevel-dir gited-show-trunk-ci-status))) + (directory-file-name gited-toplevel-dir))) + (let ((last-trunk-commit (gited--last-trunk-commit))) + (if (equal gited-last-trunk-commit last-trunk-commit) + (gited--show-trunk-ci-status) + (setq gited-last-trunk-commit last-trunk-commit) + (gited-trunk-ci-status))))) + + +(provide 'gited-ci) +;;; gited-ci.el ends here diff --git a/packages/gited/gited-tests.el b/packages/gited/gited-tests.el index 942c517..89c549c 100644 --- a/packages/gited/gited-tests.el +++ b/packages/gited/gited-tests.el @@ -28,76 +28,110 @@ (require 'ert) (require 'gited) +(eval-when-compile (require 'cl-lib)) (ert-deftest gited-test1 () - (when (executable-find vc-git-program) - (let* ((dir (make-temp-file "gited" 'dir)) - (file (expand-file-name "foo" dir)) - (gited-expert t)) - (unwind-protect - (let ((str "Initialize repository.")) - (write-region "Test file" nil file) - (dired dir) - (gited-git-command '("init")) - (gited-git-command '("config" "user.email" "john....@example.com")) - (gited-git-command '("config" "user.name" "John Doe")) + (skip-unless (executable-find vc-git-program)) + (let* ((dir (make-temp-file "gited" 'dir)) + (file (expand-file-name "foo" dir)) + (gited-expert t) + (inhibit-message t) + dired-buf) + (unwind-protect + (let ((str "Initialize repository.")) + (write-region "Test file" nil file) + (setq dired-buf (dired dir)) + (gited-git-command '("init")) + (gited-git-command '("config" "user.email" "john....@example.com")) + (gited-git-command '("config" "user.name" "John Doe")) + (gited-git-command '("add" "foo")) + (gited-git-command `("commit" "-m" ,str)) + (gited-list-branches "local") + (should (gited-dir-under-Git-control-p)) + (should (gited-buffer-p)) + (should (equal str (gited--last-commit-title))) + (should (equal "master" (gited-current-branch))) + (should-not (gited-branch-exists-p "foo")) + (gited-copy-branch "master" "foo") + (should (gited-branch-exists-p "foo")) + (gited-toggle-marks) + (should (= 2 (gited-number-marked))) + (gited-unmark-all-marks) + (should (= 0 (gited-number-marked))) + (gited-with-current-branch "foo" + (write-region "Changed this file" nil file) (gited-git-command '("add" "foo")) - (gited-git-command `("commit" "-m" ,str)) - (gited-list-branches "local") - (should (gited-dir-under-Git-control-p)) - (should (gited-buffer-p)) - (should (equal str (gited--last-commit-title))) - (should (equal "master" (gited-current-branch))) - (should-not (gited-branch-exists-p "foo")) - (gited-copy-branch "master" "foo") - (should (gited-branch-exists-p "foo")) - (gited-toggle-marks) - (should (= 2 (gited-number-marked))) + (gited-git-command '("commit" "-m" "Update file")) + (let ((hash + (with-temp-buffer + (gited-git-command + '("rev-parse" "HEAD") (current-buffer)) + (buffer-substring 1 (1- (point-max)))))) + ;; gited-mark-branches-containing-commit + (gited-mark-branches-containing-commit hash) + (should (= 1 (gited-number-marked)))) + ;; gited-mark-branches-regexp (gited-unmark-all-marks) + (gited-mark-branches-regexp "foo") + (should (= 1 (gited-number-marked))) + ;; gited-mark-branches-containing-regexp + (gited-unmark-all-marks) + (gited-mark-branches-containing-regexp "Update") + (should (= 1 (gited-number-marked))) + ;; gited-mark-branches-by-date + (gited-unmark-all-marks) + (gited-mark-branches-by-date + (format-time-string "%F" (current-time))) + (should (= (length (gited-listed-branches)) + (gited-number-marked))) + (gited-unmark-all-marks) + (gited-mark-branches-by-date + (format-time-string + "%F" + (time-add (current-time) (seconds-to-time (* 7 24 60 60))))) (should (= 0 (gited-number-marked))) - (gited-with-current-branch "foo" - ;; (gited-checkout-branch "foo") - (write-region "Changed this file" nil file) - (gited-git-command '("add" "foo")) - (gited-git-command '("commit" "-m" "Update file")) - (let ((hash - (with-temp-buffer - (gited-git-command - '("rev-parse" "HEAD") (current-buffer)) - (buffer-substring 1 (1- (point-max)))))) - ;; gited-mark-branches-containing-commit - (gited-mark-branches-containing-commit hash) - (should (= 1 (gited-number-marked)))) - ;; gited-mark-branches-regexp - (gited-unmark-all-marks) - (gited-mark-branches-regexp "foo") - (should (= 1 (gited-number-marked))) - ;; gited-mark-branches-containing-regexp - (gited-unmark-all-marks) - (gited-mark-branches-containing-regexp "Update") - (should (= 1 (gited-number-marked))) - ;; gited-mark-branches-by-date - (gited-unmark-all-marks) - (gited-mark-branches-by-date - (format-time-string "%F" (current-time))) - (should (= (length (gited-listed-branches)) - (gited-number-marked))) - (gited-unmark-all-marks) - (gited-mark-branches-by-date - (format-time-string - "%F" - (time-add (current-time) (seconds-to-time (* 7 24 60 60))))) - (should (= 0 (gited-number-marked))) - (gited-unmark-all-marks)) - (gited-copy-branch "foo" "bar") - (gited-delete-branch "foo" 'force) - (gited-update) - (should-not (gited-branch-exists-p "foo")) - (gited-rename-branch "bar" "foo") ; Asynchronous. - (while gited-branch-after-op - (sit-for 0.05)) - (should (gited-branch-exists-p "foo"))) - (delete-directory dir 'recursive))))) + (gited-unmark-all-marks)) + (gited-copy-branch "foo" "bar") + (gited-delete-branch "foo" 'force) + (gited-update) + (should-not (gited-branch-exists-p "foo")) + (gited-rename-branch "bar" "foo") ; Asynchronous. + (while gited-branch-after-op + (sit-for 0.05)) + (should (gited-branch-exists-p "foo"))) + (delete-directory dir 'recursive) + (kill-buffer dired-buf)))) + +(ert-deftest gited-test2 () + (skip-unless (executable-find vc-git-program)) + (let* ((dir (make-temp-file "gited" 'dir)) + (gited-expert t) + (inhibit-message t) + dired-buf) + (cd dir) + (unwind-protect + (progn + (gited-git-command '("clone" "https://github.com/calancha/foo")) + (setq dired-buf (dired (expand-file-name "foo"))) + (gited-list-branches "local") + (should (equal "origin" gited-current-remote-rep)) + (should-error (gited-change-current-remote-rep)) ; Only 1 remote rep + (gited-list-branches "remote") + (gited-copy-branch "origin/fail-say-foo-test" "fail-say-foo-test") + (gited-list-branches "local") + (gited-goto-branch "master") + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "fail-say-foo-test"))) + (gited-merge-branch "master")) + (load-file "do_not_delete.el") + ;; Now it fails: After merge, `say-foo' returns 'bar. + (should-not (eq 'foo (say-foo)))) + (delete-directory dir 'recursive) + (kill-buffer dired-buf)))) + +(ert-deftest gited-ci-load () + "Tests to see whether gited-ci has been loaded." + (should (fboundp 'gited-parse-ci-status))) (provide 'gited-tests) ;;; gited-tests.el ends here diff --git a/packages/gited/gited.el b/packages/gited/gited.el index 4539092..14fdbfb 100644 --- a/packages/gited/gited.el +++ b/packages/gited/gited.el @@ -8,7 +8,7 @@ ;; Created: Wed Oct 26 01:28:54 JST 2016 ;; Compatibility: GNU Emacs: 24.4 -;; Version: 0.5.1 +;; Version: 0.5.2 ;; Package-Requires: ((emacs "24.4") (cl-lib "0.5")) ;; Last-Updated: Tue May 15 13:30:52 JST 2018 ;; By: calancha @@ -244,7 +244,7 @@ ;;; Code: -;; (require 'gited-ci) ;FIXME: File not found! +(require 'gited-ci) (require 'cl-lib) (require 'tabulated-list) (require 'dired)