/ docker-context.el
docker-context.el
  1  ;;; docker-context.el --- Interface to docker-context  -*- lexical-binding: t -*-
  2  
  3  ;; Author: Pablo González Carrizo <unmonoqueteclea@gmail.com>
  4  
  5  ;; This file is NOT part of GNU Emacs.
  6  
  7  ;; This program is free software; you can redistribute it and/or modify
  8  ;; it under the terms of the GNU General Public License as published by
  9  ;; the Free Software Foundation; either version 3, or (at your option)
 10  ;; any later version.
 11  ;;
 12  ;; This program is distributed in the hope that it will be useful,
 13  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 14  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 15  ;; GNU General Public License for more details.
 16  ;;
 17  ;; You should have received a copy of the GNU General Public License
 18  ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 19  ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 20  ;; Boston, MA 02110-1301, USA.
 21  
 22  ;;; Commentary:
 23  
 24  ;;; Code:
 25  (eval-when-compile
 26    (setq-local byte-compile-warnings '(not docstrings)))
 27  
 28  (require 's)
 29  (require 'aio)
 30  (require 'dash)
 31  (require 'json)
 32  (require 'tablist)
 33  (require 'transient)
 34  
 35  (require 'docker-core)
 36  (require 'docker-faces)
 37  (require 'docker-utils)
 38  
 39  (defgroup docker-context nil
 40    "Docker context customization group."
 41    :group 'docker)
 42  
 43  (defconst docker-context-id-template
 44    "{{ json .Name }}"
 45    "This Go template extracts the context id which will be passed to transient commands.")
 46  
 47  (defcustom docker-context-default-sort-key '("Name" . nil)
 48    "Sort key for docker contexts.
 49  
 50  This should be a cons cell (NAME . FLIP) where
 51  NAME is a string matching one of the column names
 52  and FLIP is a boolean to specify the sort order."
 53    :group 'docker-context
 54    :type '(cons (string :tag "Column Name"
 55                         :validate (lambda (widget)
 56                                     (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-context-columns)
 57                                       (widget-put widget :error "Default Sort Key must match a column name")
 58                                       widget)))
 59                 (choice (const :tag "Ascending" nil)
 60                         (const :tag "Descending" t))))
 61  
 62  (defcustom docker-context-columns
 63    '((:name "Name" :width 40 :template "{{ json .Name }}" :sort nil :format nil)
 64      (:name "Description" :width 40 :template "{{ json .Description }}" :sort nil :format nil)
 65      (:name "Endpoint" :width 40 :template "{{ json .DockerEndpoint }}" :sort nil :format nil))
 66    "Column specification for docker contexts.
 67  
 68  The order of entries defines the displayed column order.
 69  'Template' is the Go template passed to `docker-context-ls' to create the column
 70  data.   It should return a string delimited with double quotes.
 71  'Sort function' is a binary predicate that should return true when the first
 72  argument should be sorted before the second.
 73  'Format function' is a function from string to string that transforms the
 74  displayed values in the column."
 75    :group 'docker-context
 76    :set 'docker-utils-columns-setter
 77    :get 'docker-utils-columns-getter
 78    :type '(repeat (list :tag "Column"
 79                         (string :tag "Name")
 80                         (integer :tag "Width")
 81                         (string :tag "Template")
 82                         (sexp :tag "Sort function")
 83                         (sexp :tag "Format function"))))
 84  
 85  (aio-defun docker-context-inspect ()
 86    "Run \"`docker-command' context inspect\" on the selected items."
 87    (interactive)
 88    (docker-inspect "context"))
 89  
 90  (aio-defun docker-context-entries (&rest args)
 91    "Return the docker contexts data for `tabulated-list-entries'."
 92    (let* ((fmt (docker-utils-make-format-string docker-context-id-template docker-context-columns))
 93           (data (aio-await (docker-run-docker-async "context" "ls" args (format "--format=\"%s\"" fmt))))
 94           (lines (s-split "\n" data t)))
 95      (-map (-partial #'docker-utils-parse docker-context-columns) lines)))
 96  
 97  (aio-defun docker-context-active-name (&rest args)
 98    (let* ((fmt "{{ json .Current }} {{ json .Name }}")
 99  	 (data (aio-await (docker-run-docker-async "context" "ls" args (format "--format=\"%s\"" fmt))))
100  	 (lines (s-split "\n" data t))
101  	 (active-line (-first (lambda (line) (string-match-p "true" (car (s-split " " line)))) lines)))
102      (when active-line
103        (cadr (split-string active-line "\"")))))
104  
105  (aio-defun docker-context-entries-propertized (&rest args)
106    "Return the propertized docker contexts data for `tabulated-list-entries'."
107    (let ((entries (aio-await (docker-context-entries args)))
108          (active (aio-await (docker-context-active-name args))))
109      (--map-when (string= active (car it)) (docker-context-entry-set-active it) entries)))
110  
111  (defun docker-context-entry-set-active (entry)
112    "Mark ENTRY (output of `docker-context-entries') as active.
113  
114  The result is the tabulated list id for an entry is propertized with
115  'docker-context-active and the entry is fontified with 'docker-face-active."
116    (list (propertize (car entry) 'docker-context-active t)
117          (apply #'vector (--map (propertize it 'font-lock-face 'docker-face-active) (cadr entry)))))
118  
119  
120  (aio-defun docker-context-update-status-async ()
121    "Write the status to `docker-status-strings'."
122    (plist-put docker-status-strings :contexts "Contexts")
123    (when (or (eq docker-show-status t) (and (eq docker-show-status 'local-only) (not (file-remote-p default-directory))))
124      (let* ((entries (aio-await (docker-context-entries-propertized (docker-context-ls-arguments)))))
125        (plist-put docker-status-strings
126                   :contexts
127                   (format "Context (%s total)" (number-to-string (length entries))))
128        (transient--redisplay))))
129  
130  (add-hook 'docker-open-hook #'docker-context-update-status-async)
131  
132  (aio-defun docker-context-refresh ()
133    "Refresh the contexts list."
134    (docker-utils-refresh-entries
135     (docker-context-entries-propertized (docker-context-ls-arguments))))
136  
137  (docker-utils-define-transient-arguments docker-context-ls)
138  
139  (docker-utils-transient-define-prefix docker-context-rm ()
140    "Transient for removing contexts."
141    :man-page "docker-context-rm"
142    [:description docker-generic-action-description
143  		("D" "Remove" docker-generic-action-multiple-ids)])
144  
145  (docker-utils-transient-define-prefix docker-context-use ()
146    "Transient for using contexts."
147    :man-page "docker-context-use"
148    [:description docker-generic-action-description
149  		("X" "Use" docker-generic-action)])
150  
151  (transient-define-prefix docker-context-help ()
152    "Help transient for docker contexts."
153    ["Docker contexts help"
154     ("D" "Remove"  docker-context-rm)
155     ("I" "Inspect" docker-context-inspect)
156     ("X" "Use"     docker-context-use)])
157  
158  (defvar docker-context-mode-map
159    (let ((map (make-sparse-keymap)))
160      (define-key map "?" 'docker-context-help)
161      (define-key map "D" 'docker-context-rm)
162      (define-key map "I" 'docker-context-inspect)
163      (define-key map "X" 'docker-context-use)
164      map)
165    "Keymap for `docker-context-mode'.")
166  
167  ;;;###autoload (autoload 'docker-contexts "docker-context" nil t)
168  (defun docker-contexts ()
169    "List docker contexts."
170    (interactive)
171    (docker-utils-pop-to-buffer "*docker-contexts*")
172    (docker-context-mode)
173    (tablist-revert))
174  
175  (define-derived-mode docker-context-mode tabulated-list-mode "Contexts Menu"
176    "Major mode for handling a list of docker contexts."
177    (setq tabulated-list-format (docker-utils-columns-list-format docker-context-columns))
178    (setq tabulated-list-padding 2)
179    (setq tabulated-list-sort-key docker-context-default-sort-key)
180    (add-hook 'tabulated-list-revert-hook 'docker-context-refresh nil t)
181    (tabulated-list-init-header)
182    (tablist-minor-mode))
183  
184  (provide 'docker-context)
185  
186  ;;; docker-context.el ends here