[elpa] master cfa7c4e: Add missing file gited-ci.el

[Tino Calancha]

branch: master
commit cfa7c4eab13e07177a9ad5e2e164aaca693e0930
Author: Tino Calancha <address@hidden>
Commit: Tino Calancha <address@hidden>

    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 <address@hidden>
+;; Maintainer: Tino Calancha <address@hidden>
+;; 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" "address@hidden"))
-               (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" "address@hidden"))
+             (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)