9da3ffee41
This is a massive diff that I had to do in a hurry - when leaving Urbint. I'm pretty sure that most of these are updating Emacs packages, but I'm not positive.
273 lines
9.7 KiB
EmacsLisp
273 lines
9.7 KiB
EmacsLisp
;;; docker-image.el --- Emacs interface to docker-image -*- lexical-binding: t -*-
|
|
|
|
;; Author: Philippe Vaucher <philippe.vaucher@gmail.com>
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; This program 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, or (at your option)
|
|
;; any later version.
|
|
;;
|
|
;; This program 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; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; Code:
|
|
|
|
(require 's)
|
|
(require 'dash)
|
|
(require 'json)
|
|
(require 'tablist)
|
|
(require 'magit-popup)
|
|
|
|
(require 'docker-group)
|
|
(require 'docker-process)
|
|
(require 'docker-utils)
|
|
|
|
(defgroup docker-image nil
|
|
"Docker images customization group."
|
|
:group 'docker)
|
|
|
|
(defcustom docker-image-default-sort-key '("Repository" . nil)
|
|
"Sort key for docker images.
|
|
|
|
This should be a cons cell (NAME . FLIP) where
|
|
NAME is a string matching one of the column names
|
|
and FLIP is a boolean to specify the sort order."
|
|
:group 'docker-image
|
|
:type '(cons (choice (const "Repository")
|
|
(const "Tag")
|
|
(const "Id")
|
|
(const "Created")
|
|
(const "Size"))
|
|
(choice (const :tag "Ascending" nil)
|
|
(const :tag "Descending" t))))
|
|
|
|
(defcustom docker-image-run-arguments '("-i" "-t" "--rm")
|
|
"Default arguments for `docker-image-run-popup'."
|
|
:group 'docker-image
|
|
:type '(repeat (string :tag "Argument")))
|
|
|
|
(defun docker-image-parse (line)
|
|
"Convert a LINE from \"docker images\" to a `tabulated-list-entries' entry."
|
|
(let* ((data (s-split "\t" line))
|
|
(name (format "%s:%s" (nth 0 data) (nth 1 data))))
|
|
(setf (nth 3 data) (format-time-string "%F %T" (date-to-time (nth 3 data))))
|
|
(list
|
|
(if (s-contains? "<none>" name) (nth 2 data) name)
|
|
(apply #'vector data))))
|
|
|
|
(defun docker-image-entries ()
|
|
"Return the docker images data for `tabulated-list-entries'."
|
|
(let* ((fmt "{{.Repository}}\\t{{.Tag}}\\t{{.ID}}\\t{{.CreatedAt}}\\t{{.Size}}")
|
|
(data (docker-run "image ls" docker-image-ls-arguments (format "--format=\"%s\"" fmt)))
|
|
(lines (s-split "\n" data t)))
|
|
(-map #'docker-image-parse lines)))
|
|
|
|
(defun docker-image-refresh ()
|
|
"Refresh the images list."
|
|
(setq tabulated-list-entries (docker-image-entries)))
|
|
|
|
(defun docker-image-read-name ()
|
|
"Read an image name."
|
|
(completing-read "Image: " (-map #'car (docker-image-entries))))
|
|
|
|
(defun docker-image-human-size-predicate (a b)
|
|
"Sort A and B by image size."
|
|
(let* ((a-size (elt (cadr a) 4))
|
|
(b-size (elt (cadr b) 4)))
|
|
(< (docker-utils-human-size-to-bytes a-size) (docker-utils-human-size-to-bytes b-size))))
|
|
|
|
;;;###autoload
|
|
(defun docker-pull (name &optional all)
|
|
"Pull the image named NAME. If ALL is set, use \"-a\"."
|
|
(interactive (list (docker-image-read-name) current-prefix-arg))
|
|
(docker-run "pull" (when all "-a ") name))
|
|
|
|
;;;###autoload
|
|
(defun docker-push (name)
|
|
"Push the image named NAME."
|
|
(interactive (list (docker-image-read-name)))
|
|
(docker-run "push" name))
|
|
|
|
;;;###autoload
|
|
(defun docker-rmi (name &optional force no-prune)
|
|
"Destroy or untag the image named NAME.
|
|
|
|
Force removal of the image when FORCE is set.
|
|
Do not delete untagged parents when NO-PRUNE is set."
|
|
(interactive (list (docker-image-read-name) current-prefix-arg))
|
|
(docker-run "rmi" (when force "-f") (when no-prune "--no-prune") name))
|
|
|
|
;;;###autoload
|
|
(defun docker-tag (image name)
|
|
"Tag IMAGE using NAME."
|
|
(interactive (list (docker-image-read-name) (read-string "Name: ")))
|
|
(docker-run "tag" image name))
|
|
|
|
(defun docker-image-inspect-selection ()
|
|
"Run \"docker inspect\" on the images selection."
|
|
(interactive)
|
|
(--each (docker-utils-get-marked-items-ids)
|
|
(docker-utils-with-buffer (format "inspect %s" it)
|
|
(insert (docker-run "inspect" (docker-image-inspect-arguments) it))
|
|
(json-mode))))
|
|
|
|
(defun docker-image-pull-selection ()
|
|
"Run \"docker pull\" on the images selection."
|
|
(interactive)
|
|
(--each (docker-utils-get-marked-items-ids)
|
|
(docker-run "pull" (docker-image-pull-arguments) it))
|
|
(tablist-revert))
|
|
|
|
(defun docker-image-push-selection ()
|
|
"Run \"docker push\" on the images selection."
|
|
(interactive)
|
|
(--each (docker-utils-get-marked-items-ids)
|
|
(docker-run "push" (docker-image-push-arguments) it)))
|
|
|
|
(defun docker-image-rm-selection ()
|
|
"Run \"docker rmi\" on the images selection."
|
|
(interactive)
|
|
(--each (docker-utils-get-marked-items-ids)
|
|
(docker-run "rmi" (docker-image-rm-arguments) it))
|
|
(tablist-revert))
|
|
|
|
(defun docker-image-run-selection (command)
|
|
"Run \"docker run\" on the images selection."
|
|
(interactive "sCommand: ")
|
|
(let ((default-directory (if (and docker-run-as-root
|
|
(not (file-remote-p default-directory)))
|
|
"/sudo::"
|
|
default-directory)))
|
|
(--each (docker-utils-get-marked-items-ids)
|
|
(async-shell-command
|
|
(format "%s run %s %s %s" docker-command (s-join " " (docker-image-run-arguments)) it command)
|
|
(generate-new-buffer (format "*run %s*" it))))))
|
|
|
|
(defun docker-image-tag-selection ()
|
|
"Tag images."
|
|
(interactive)
|
|
(docker-utils-select-if-empty)
|
|
(--each (docker-utils-get-marked-items-ids)
|
|
(docker-tag it (read-string (format "Tag for %s: " it))))
|
|
(tablist-revert))
|
|
|
|
(magit-define-popup docker-image-inspect-popup
|
|
"Popup for inspecting images."
|
|
'docker-image
|
|
:man-page "docker-inspect"
|
|
:actions '((?I "Inspect" docker-image-inspect-selection))
|
|
:setup-function #'docker-utils-setup-popup)
|
|
|
|
(magit-define-popup docker-image-ls-popup
|
|
"Popup for listing images."
|
|
'docker-image
|
|
:man-page "docker-image-ls"
|
|
:switches '((?a "All" "--all")
|
|
(?d "Dangling" "-f dangling=true")
|
|
(?n "Don't truncate" "--no-trunc"))
|
|
:options '((?f "Filter" "--filter "))
|
|
:actions `((?l "List" ,(docker-utils-set-then-call 'docker-image-ls-arguments 'tablist-revert))))
|
|
|
|
(magit-define-popup docker-image-pull-popup
|
|
"Popup for pulling images."
|
|
'docker-image
|
|
:man-page "docker-pull"
|
|
:switches '((?a "All" "-a"))
|
|
:actions '((?F "Pull" docker-image-pull-selection))
|
|
:setup-function #'docker-utils-setup-popup)
|
|
|
|
(magit-define-popup docker-image-push-popup
|
|
"Popup for pushing images."
|
|
'docker-image
|
|
:man-page "docker-push"
|
|
:actions '((?P "Push" docker-image-push-selection))
|
|
:setup-function #'docker-utils-setup-popup)
|
|
|
|
(magit-define-popup docker-image-rm-popup
|
|
"Popup for removing images."
|
|
'docker-image
|
|
:man-page "docker-rmi"
|
|
:switches '((?f "Force" "-f")
|
|
(?n "Don't prune" "--no-prune"))
|
|
:actions '((?D "Remove" docker-image-rm-selection))
|
|
:setup-function #'docker-utils-setup-popup)
|
|
|
|
(magit-define-popup docker-image-run-popup
|
|
"Popup for running images."
|
|
'docker-image
|
|
:man-page "docker-run"
|
|
:switches '((?D "With display" "-v /tmp/.X11-unix:/tmp/.X11-unix -e DISPLAY")
|
|
(?T "Synchronize time" "-v /etc/localtime:/etc/localtime:ro")
|
|
(?W "Web ports" "-p 80:80 -p 443:443 -p 8080:8080")
|
|
(?d "Daemonize" "-d")
|
|
(?i "Interactive" "-i")
|
|
(?o "Read only" "--read-only")
|
|
(?p "Privileged" "--privileged")
|
|
(?r "Remove container when it exits" "--rm")
|
|
(?t "TTY" "-t"))
|
|
:options '((?e "environment" "-e ")
|
|
(?m "name" "--name ")
|
|
(?n "entrypoint" "--entrypoint ")
|
|
(?p "port" "-p ")
|
|
(?u "user" "-u ")
|
|
(?v "volume" "-v ")
|
|
(?w "workdir" "-w "))
|
|
:actions '((?R "Run images" docker-image-run-selection))
|
|
:setup-function #'docker-utils-setup-popup)
|
|
|
|
(magit-define-popup docker-image-help-popup
|
|
"Help popup for docker images."
|
|
'docker-image
|
|
:actions '("Docker images help"
|
|
(?D "Remove" docker-image-rm-popup)
|
|
(?F "Pull" docker-image-pull-popup)
|
|
(?I "Inspect" docker-image-inspect-popup)
|
|
(?P "Push" docker-image-push-popup)
|
|
(?R "Run" docker-image-run-popup)
|
|
(?T "Tag" docker-image-tag-selection)
|
|
(?l "List" docker-image-ls-popup)))
|
|
|
|
(defvar docker-image-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map "?" 'docker-image-help-popup)
|
|
(define-key map "D" 'docker-image-rm-popup)
|
|
(define-key map "F" 'docker-image-pull-popup)
|
|
(define-key map "I" 'docker-image-inspect-popup)
|
|
(define-key map "P" 'docker-image-push-popup)
|
|
(define-key map "R" 'docker-image-run-popup)
|
|
(define-key map "T" 'docker-image-tag-selection)
|
|
(define-key map "l" 'docker-image-ls-popup)
|
|
map)
|
|
"Keymap for `docker-image-mode'.")
|
|
|
|
;;;###autoload
|
|
(defun docker-images ()
|
|
"List docker images."
|
|
(interactive)
|
|
(docker-utils-pop-to-buffer "*docker-images*")
|
|
(docker-image-mode)
|
|
(tablist-revert))
|
|
|
|
(define-derived-mode docker-image-mode tabulated-list-mode "Images Menu"
|
|
"Major mode for handling a list of docker images."
|
|
(setq tabulated-list-format [("Repository" 30 t)("Tag" 20 t)("Id" 16 t)("Created" 23 t)("Size" 10 docker-image-human-size-predicate)])
|
|
(setq tabulated-list-padding 2)
|
|
(setq tabulated-list-sort-key docker-image-default-sort-key)
|
|
(add-hook 'tabulated-list-revert-hook 'docker-image-refresh nil t)
|
|
(tabulated-list-init-header)
|
|
(tablist-minor-mode))
|
|
|
|
(provide 'docker-image)
|
|
|
|
;;; docker-image.el ends here
|