(add-hook 'sql-interactive-mode-hook 'rainbow-delimiters-mode)
#+end_src
+* docker
+[2025-11-25 Tue 12:48]
+
+#+begin_src emacs-lisp
+ (require 'docker)
+ (global-set-key "\C-cd" 'docker)
+ (eval-after-load 'docker
+ '(add-hook 'dockerfile-mode-hook '(lambda() (define-key dockerfile-mode-map "\C-c\C-c" 'compile)
+ (setq compile-command "docker build -t tag ."))))
+#+end_src
* [[https://github.com/hrs/engine-mode][engine-mode]]
search the web on your fingertips. C-c /.
--- /dev/null
+;;; docker-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from docker-compose.el
+
+ (autoload 'docker-compose "docker-compose" nil t)
+(register-definition-prefixes "docker-compose" '("docker-compose-"))
+
+\f
+;;; Generated autoloads from docker-container.el
+
+ (autoload 'docker-container-eshell "docker-container" nil t)
+ (autoload 'docker-container-find-directory "docker-container" nil t)
+ (autoload 'docker-container-find-file "docker-container" nil t)
+ (autoload 'docker-container-shell "docker-container" nil t)
+ (autoload 'docker-container-shell-env "docker-container" nil t)
+ (autoload 'docker-container-vterm "docker-container" nil t)
+ (autoload 'docker-container-vterm-env "docker-container" nil t)
+ (autoload 'docker-container-eat "docker-container" nil t)
+ (autoload 'docker-container-eat-env "docker-container" nil t)
+ (autoload 'docker-containers "docker-container" nil t)
+(register-definition-prefixes "docker-container" '("docker-container-"))
+
+\f
+;;; Generated autoloads from docker-context.el
+
+ (autoload 'docker-contexts "docker-context" nil t)
+(register-definition-prefixes "docker-context" '("docker-context-"))
+
+\f
+;;; Generated autoloads from docker-core.el
+
+ (autoload 'docker "docker" nil t)
+(register-definition-prefixes "docker-core" '("docker-"))
+
+\f
+;;; Generated autoloads from docker-image.el
+
+ (autoload 'docker-image-pull-one "docker-image" nil t)
+ (autoload 'docker-images "docker-image" nil t)
+(register-definition-prefixes "docker-image" '("docker-"))
+
+\f
+;;; Generated autoloads from docker-network.el
+
+ (autoload 'docker-networks "docker-network" nil t)
+(register-definition-prefixes "docker-network" '("docker-network-"))
+
+\f
+;;; Generated autoloads from docker-process.el
+
+(register-definition-prefixes "docker-process" '("docker-"))
+
+\f
+;;; Generated autoloads from docker-utils.el
+
+(register-definition-prefixes "docker-utils" '("docker-"))
+
+\f
+;;; Generated autoloads from docker-volume.el
+
+ (autoload 'docker-volume-dired "docker-volume" nil t)
+ (autoload 'docker-volumes "docker-volume" nil t)
+(register-definition-prefixes "docker-volume" '("docker-volume-"))
+\f
+;;; End of scraped data
+
+(provide 'docker-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; docker-autoloads.el ends here
--- /dev/null
+;;; docker-compose.el --- Interface to docker-compose -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+(require 'transient)
+
+(require 'docker-group)
+(require 'docker-utils)
+(require 'docker-process)
+
+(defgroup docker-compose nil
+ "Docker compose customization group."
+ :group 'docker)
+
+(defcustom docker-compose-command "docker compose"
+ "The `docker-compose' binary."
+ :group 'docker-compose
+ :type 'string)
+
+(defun docker-compose-run-docker-compose-async (action &rest args)
+ "Execute \"`docker-compose-command' ACTION ARGS\" and return a promise with the results."
+ (apply #'docker-run-async docker-compose-command (docker-compose-arguments) action args))
+
+(defun docker-compose-run-docker-compose-async-with-buffer (action &rest args)
+ "Execute \"`docker-compose-command' ACTION ARGS\" and display output in a new buffer."
+ (apply #'docker-run-async-with-buffer docker-compose-command (docker-compose-arguments) action args))
+
+(aio-defun docker-compose-services ()
+ "Return the list of services."
+ (s-split "\n" (aio-await (docker-compose-run-docker-compose-async "config" "--services" "2>/dev/null")) t))
+
+(aio-defun docker-compose-read-services-names ()
+ "Read the services names."
+ (completing-read-multiple "Services: " (aio-await (docker-compose-services))))
+
+(aio-defun docker-compose-read-service-name ()
+ "Read one service name."
+ (completing-read "Service: " (aio-await (docker-compose-services))))
+
+(defun docker-compose-read-project (prompt &rest _args)
+ "Read the `docker-compose' project forwarding PROMPT."
+ (completing-read
+ prompt
+ ;; in docker compose v2, we can obtain the list of
+ ;; projects with 'ls' argument
+ (if (string-match-p "*?docker compose*?" docker-compose-command)
+ (split-string
+ (shell-command-to-string
+ (concat docker-compose-command " ls" " --all" " -q"))
+ "\n"
+ t))))
+
+(defun docker-compose-read-log-level (prompt &rest _args)
+ "Read the `docker-compose' log level forwarding PROMPT."
+ (completing-read prompt '(DEBUG INFO WARNING ERROR CRITICAL)))
+
+(defun docker-compose-read-directory (prompt &optional initial-input _history)
+ "Wrapper around `read-directory-name' forwarding PROMPT and INITIAL-INPUT."
+ (read-directory-name prompt nil nil t initial-input))
+
+(defun docker-compose-read-environment-file (prompt &optional initial-input _history)
+ "Wrapper around `read-file-name' forwarding PROMPT and INITIAL-INPUT."
+ (read-file-name prompt nil nil t initial-input))
+
+(defun docker-compose-read-compose-file (prompt &optional initial-input _history)
+ "Wrapper around `read-file-name' forwarding PROMPT and INITIAL-INPUT."
+ (read-file-name prompt nil nil t initial-input (apply-partially 'string-match ".*\\.yml\\|.*\\.yaml")))
+
+(aio-defun docker-compose-run-action-for-one-service (action args services)
+ "Run \"docker-compose ACTION ARGS SERVICES\"."
+ (interactive (list
+ (-last-item (s-split "-" (symbol-name transient-current-command)))
+ (transient-args transient-current-command)
+ nil))
+ (setq services (aio-await (docker-compose-read-services-names)))
+ (docker-compose-run-docker-compose-async-with-buffer action args services))
+
+(defun docker-compose-run-action-for-all-services (action args)
+ "Run \"docker-compose ACTION ARGS\"."
+ (interactive (list
+ (-last-item (s-split "-" (symbol-name transient-current-command)))
+ (transient-args transient-current-command)))
+ (docker-compose-run-docker-compose-async-with-buffer action args))
+
+(aio-defun docker-compose-run-action-with-command (action args service command)
+ "Run \"docker-compose ACTION ARGS SERVICE COMMAND\"."
+ (interactive (list
+ (-last-item (s-split "-" (symbol-name transient-current-command)))
+ (transient-args transient-current-command)
+ nil
+ (read-string "Command: ")))
+ (setq service (aio-await (docker-compose-read-service-name)))
+ (docker-compose-run-docker-compose-async-with-buffer action args service command))
+
+(transient-define-prefix docker-compose-build ()
+ "Transient for \"docker-compose build\"."
+ :man-page "docker-compose build"
+ ["Arguments"
+ ("b" "Build argument" "--build-arg " read-string)
+ ("c" "Compress build context" "--compress")
+ ("f" "Always remove intermediate containers" "--force-rm")
+ ("m" "Memory limit" "--memory " transient-read-number-N0)
+ ("n" "Do not use cache" "--no-cache")
+ ("p" "Attempt to pull a newer version of the image" "--pull")
+ ("r" "Build images in parallel" "--parallel")]
+ ["Actions"
+ ("B" "Build" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-config ()
+ "Transient for \"docker-compose config\"."
+ :man-page "docker-compose config"
+ ["Arguments"
+
+ ("r" "Pin image tags to digests" "--resolve-image-digests")
+ ("s" "Print the service names" "--services")
+ ("v" "Print the volume names" "--volumes")]
+ ["Actions"
+ ("V" "Config" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-create ()
+ "Transient for \"docker-compose create\"."
+ :man-page "docker-compose create"
+ ["Arguments"
+ ("b" "Build" "--build")
+ ("f" "Force recreate" "--force-recreate")
+ ("n" "No recreate" "--no-recreate")]
+ ["Actions"
+ ("C" "Create" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-down ()
+ "Transient for \"docker-compose down\"."
+ :man-page "docker-compose down"
+ ["Arguments"
+ ("o" "Remove orphans" "--remove-orphans")
+ ("t" "Timeout" "--timeout " transient-read-number-N0)
+ ("v" "Remove volumes" "--volumes")]
+ ["Actions"
+ ("W" "Down" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-exec ()
+ "Transient for \"docker-compose exec\"."
+ :man-page "docker-compose exec"
+ ["Arguments"
+ ("P" "Privileged" "--privileged")
+ ("T" "Disable pseudo-tty" "-T")
+ ("d" "Detach" "-d")
+ ("e" "Env KEY=VAL" "-e " read-string)
+ ("u" "User " "--user " read-string)
+ ("w" "Workdir" "--workdir " read-string)]
+ ["Actions"
+ ("E" "Exec" docker-compose-run-action-with-command)])
+
+(transient-define-prefix docker-compose-logs ()
+ "Transient for \"docker-compose logs\"."
+ :man-page "docker-compose logs"
+ ["Arguments"
+ ("T" "Tail" "--tail " read-string)
+ ("f" "Follow" "--follow")
+ ("n" "No color" "--no-color")
+ ("t" "Timestamps" "--timestamps")]
+ ["Actions"
+ ("L" "Logs" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-pull ()
+ "Transient for \"docker-compose pull\"."
+ :man-page "docker-compose pull"
+ ["Arguments"
+ ("d" "Include dependencies" "--include-deps")
+ ("i" "Ignore pull failures" "--ignore-pull-failures")
+ ("n" "No parallel" "--no-parallel")]
+ ["Actions"
+ ("F" "Pull" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-push ()
+ "Transient for \"docker-compose push\"."
+ :man-page "docker-compose push"
+ ["Arguments"
+ ("i" "Ignore push failures" "--ignore-push-failures")]
+ ["Actions"
+ ("P" "Push" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-restart ()
+ "Transient for \"docker-compose restart\"."
+ :man-page "docker-compose restart"
+ ["Arguments"
+ ("t" "Timeout" "--timeout " transient-read-number-N0)]
+ ["Actions"
+ ("T" "Restart" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-rm ()
+ "Transient for \"docker-compose rm\"."
+ :man-page "docker-compose rm"
+ ["Arguments"
+ ("f" "Force" "--force")
+ ("s" "Stop" "--stop")
+ ("v" "Remove anonymous volumes" "-v")]
+ ["Actions"
+ ("D" "Remove" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-run ()
+ "Transient for \"docker-compose run\"."
+ :man-page "docker-compose run"
+ :value '("--rm")
+ ["Arguments"
+ ("E" "Entrypoint" "--entrypoint " read-string)
+ ("N" "Name" "--name " read-string)
+ ("T" "Disable pseudo-tty" "-T")
+ ("d" "Detach" "-d")
+ ("e" "Env KEY=VAL" "-e " read-string)
+ ("l" "Label" "--label " read-string)
+ ("n" "No deps" "--no-deps")
+ ("r" "Remove container when it exits" "--rm")
+ ("s" "Enable services ports" "--service-ports")
+ ("u" "User " "--user " read-string)
+ ("w" "Workdir" "--workdir " read-string)]
+ ["Actions"
+ ("R" "Run" docker-compose-run-action-with-command)])
+
+(transient-define-prefix docker-compose-start ()
+ "Transient for \"docker-compose start\"."
+ :man-page "docker-compose start"
+ ["Actions"
+ ("S" "Start" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-stop ()
+ "Transient for \"docker-compose stop\"."
+ :man-page "docker-compose stop"
+ ["Arguments"
+ ("t" "Timeout" "--timeout " transient-read-number-N0)]
+ ["Actions"
+ ("O" "Stop" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-up ()
+ "Transient for \"docker-compose up\"."
+ :man-page "docker-compose up"
+ ["Arguments"
+ ("b" "Build" "--build")
+ ("c" "Scale" "--scale " transient-read-number-N0)
+ ("d" "Detach" "-d")
+ ("f" "Force recreate" "--force-recreate")
+ ("n" "No deps" "--no-deps")
+ ("q" "Quiet pull" "--quiet-pull")
+ ("r" "Remove orphans" "--remove-orphans")
+ ("t" "Timeout" "--timeout " transient-read-number-N0)]
+ ["Actions"
+ ("U" "Up" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-pause ()
+ "Transient for \"docker-compose pause\"."
+ :man-page "docker-compose pause"
+ ["Actions"
+ ("Z" "Pause" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(transient-define-prefix docker-compose-unpause ()
+ "Transient for \"docker-compose unpause\"."
+ :man-page "docker-compose unpause"
+ ["Actions"
+ ("N" "Unpause" docker-compose-run-action-for-one-service)
+ ("A" "All services" docker-compose-run-action-for-all-services)])
+
+(docker-utils-define-transient-arguments docker-compose)
+
+;;;###autoload (autoload 'docker-compose "docker-compose" nil t)
+(transient-define-prefix docker-compose ()
+ "Transient for docker-compose."
+ :man-page "docker-compose"
+ ["Arguments"
+ ("a" "No ANSI" "--no-ansi")
+ ("c" "Compatibility" "--compatibility")
+ ("d" "Project directory" "--project-directory " docker-compose-read-directory)
+ ("e" "Environment file" "--env-file " docker-compose-read-environment-file)
+ ("f" "Compose file" "--file " docker-compose-read-compose-file)
+ ("h" "Host" "--host " read-string)
+ ("l" "Log level" "--log-level " docker-compose-read-log-level)
+ ("p" "Project name" "--project-name " docker-compose-read-project)
+ ("r" "Profile" "--profile " read-string)
+ ("v" "Verbose" "--verbose")]
+ [["Images"
+ ("B" "Build" docker-compose-build)
+ ("F" "Pull" docker-compose-pull)
+ ("P" "Push" docker-compose-push)]
+ ["Containers"
+ ("C" "Create" docker-compose-create)
+ ("D" "Remove" docker-compose-rm)
+ ("Z" "Pause" docker-compose-pause)
+ ("N" "Unpause" docker-compose-unpause)
+ ("U" "Up" docker-compose-up)
+ ("W" "Down" docker-compose-down)]
+ ["State"
+ ("O" "Stop" docker-compose-stop)
+ ("S" "Start" docker-compose-start)
+ ("T" "Restart" docker-compose-restart)]
+ ["Other"
+ ("E" "Exec" docker-compose-exec)
+ ("L" "Logs" docker-compose-logs)
+ ("R" "Run" docker-compose-run)
+ ("V" "Config" docker-compose-config)]])
+
+(provide 'docker-compose)
+
+;;; docker-compose.el ends here
--- /dev/null
+;;; docker-container.el --- Interface to docker-container -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.com>
+;; Yuki Inoue <inouetakahirokiNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+(require 'json)
+(require 'tablist)
+(require 'transient)
+
+(require 'docker-core)
+(require 'docker-faces)
+(require 'docker-utils)
+
+(defgroup docker-container nil
+ "Docker container customization group."
+ :group 'docker)
+
+(defconst docker-container-id-template
+ "{{ json .Names }}"
+ "This Go template extracts the container id which will be passed to transient commands.")
+
+(defcustom docker-container-shell-file-name "/bin/sh"
+ "Shell to use when entering containers."
+ :group 'docker-container
+ :type 'string)
+
+(defcustom docker-container-tramp-method "docker"
+ "TRAMP method to use for connecting to Docker containers."
+ :group 'docker-container
+ :type 'string)
+
+(defcustom docker-container-default-sort-key '("Image" . nil)
+ "Sort key for docker containers.
+
+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-container
+ :type '(cons (string :tag "Column Name"
+ :validate (lambda (widget)
+ (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-container-columns)
+ (widget-put widget :error "Default Sort Key must match a column name")
+ widget)))
+ (choice (const :tag "Ascending" nil)
+ (const :tag "Descending" t))))
+
+(defcustom docker-container-columns
+ '((:name "Id" :width 16 :template "{{ json .ID }}" :sort nil :format nil)
+ (:name "Image" :width 15 :template "{{ json .Image }}" :sort nil :format nil)
+ (:name "Command" :width 30 :template "{{ json .Command }}" :sort nil :format nil)
+ (:name "Created" :width 23 :template "{{ json .CreatedAt }}" :sort nil :format (lambda (x) (format-time-string "%F %T" (date-to-time x))))
+ (:name "Status" :width 20 :template "{{ json .Status }}" :sort nil :format nil)
+ (:name "Ports" :width 10 :template "{{ json .Ports }}" :sort nil :format nil)
+ (:name "Names" :width 10 :template "{{ json .Names }}" :sort nil :format nil))
+ "Column specification for docker containers.
+
+The order of entries defines the displayed column order. 'Template' is
+the Go template passed to `docker-container-ls' to create the column data.
+It should return a string delimited with double quotes. 'Sort function' is
+a binary predicate that should return true when the first argument should be
+sorted before the second. 'Format function' is a function from string to
+string that transforms the displayed values in the column."
+ :group 'docker-container
+ :set 'docker-utils-columns-setter
+ :get 'docker-utils-columns-getter
+ :type '(repeat (list :tag "Column"
+ (string :tag "Name")
+ (integer :tag "Width")
+ (string :tag "Template")
+ (sexp :tag "Sort function")
+ (sexp :tag "Format function"))))
+
+(defalias 'docker-container-inspect 'docker-inspect)
+
+(defun docker-container--read-shell (&optional read-shell-name)
+ "Return `docker-container-shell-file-name' or read a shell name if READ-SHELL-NAME is truthy."
+ (if read-shell-name (read-shell-command "Shell: ") docker-container-shell-file-name))
+
+(defun docker-container-status-face (status)
+ "Return the correct face according to STATUS."
+ (cond
+ ((s-starts-with? "Up" status)
+ 'docker-face-status-up)
+ ((s-starts-with? "Exited" status)
+ 'docker-face-status-down)
+ (t
+ 'docker-face-status-other)))
+
+(aio-defun docker-container-entries (&rest args)
+ "Return the docker containers data for `tabulated-list-entries'."
+ (let* ((fmt (docker-utils-make-format-string docker-container-id-template docker-container-columns))
+ (data (aio-await (docker-run-docker-async "container" "ls" args (format "--format=\"%s\"" fmt))))
+ (lines (s-split "\n" data t)))
+ (-map (-partial #'docker-utils-parse docker-container-columns) lines)))
+
+(aio-defun docker-container-entries-propertized (&rest args)
+ "Return the propertized docker containers data for `tabulated-list-entries'."
+ (let ((entries (aio-await (docker-container-entries args))))
+ (-map #'docker-container-propertize-entry entries)))
+
+(defun docker-container-propertize-entry (entry)
+ "Propertize ENTRY."
+ (let* ((index (--find-index (string-equal "Status" (plist-get it :name)) docker-container-columns))
+ (data (cadr entry))
+ (status (aref data index)))
+ (aset data index (propertize status 'font-lock-face (docker-container-status-face status)))
+ entry))
+
+(aio-defun docker-container-update-status-async ()
+ "Write the status to `docker-status-strings'."
+ (plist-put docker-status-strings :containers "Containers")
+ (when (or (eq docker-show-status t) (and (eq docker-show-status 'local-only) (not (file-remote-p default-directory))))
+ (let* ((entries (aio-await (docker-container-entries-propertized (docker-container-ls-arguments))))
+ (index (--find-index (string-equal "Status" (plist-get it :name)) docker-container-columns))
+ (statuses (--map (aref (cadr it) index) entries))
+ (faces (--map (get-text-property 0 'font-lock-face it) statuses))
+ (all (length faces))
+ (up (-count (-partial #'equal 'docker-face-status-up) faces))
+ (down (-count (-partial #'equal 'docker-face-status-down) faces))
+ (other (- all up down)))
+ (plist-put docker-status-strings
+ :containers
+ (format "Containers (%s total, %s up, %s down, %s other)"
+ all
+ (propertize (number-to-string up) 'face 'docker-face-status-up)
+ (propertize (number-to-string down) 'face 'docker-face-status-down)
+ (propertize (number-to-string other) 'face 'docker-face-status-other)))
+ (transient--redisplay))))
+
+(add-hook 'docker-open-hook #'docker-container-update-status-async)
+
+(aio-defun docker-container-refresh ()
+ "Refresh the containers list."
+ (docker-utils-refresh-entries
+ (docker-container-entries-propertized (docker-container-ls-arguments))))
+
+(defun docker-container-read-name ()
+ "Read an container name."
+ (completing-read "Container: " (-map #'car (aio-wait-for (docker-container-entries)))))
+
+(defvar eshell-buffer-name)
+
+;;;###autoload (autoload 'docker-container-eshell "docker-container" nil t)
+(defun docker-container-eshell (container)
+ "Open `eshell' in CONTAINER."
+ (interactive (list (docker-container-read-name)))
+ (let* ((container-address (format "%s:%s:/" docker-container-tramp-method container))
+ (file-prefix (let ((prefix (file-remote-p default-directory)))
+ (if prefix
+ (format "%s|" (s-chop-suffix ":" prefix))
+ "/")))
+ (default-directory (format "%s%s" file-prefix container-address))
+ (eshell-buffer-name (docker-utils-generate-new-buffer-name "docker" "eshell:" default-directory)))
+ (eshell)))
+
+(defun docker-container-assert-tramp-docker ()
+ "Assert tramp docker support is available."
+ (unless (or (docker-utils-package-p 'docker-container)
+ (docker-utils-package-p 'docker-tramp))
+ (error "Tramp docker support was not detected, try installing docker-tramp")))
+
+;;;###autoload (autoload 'docker-container-find-directory "docker-container" nil t)
+(defun docker-container-find-directory (container directory)
+ "Inside CONTAINER open DIRECTORY."
+ (interactive
+ (let* ((container-name (docker-container-read-name))
+ (tramp-filename (read-directory-name "Directory: " (format "/%s:%s:/" docker-container-tramp-method container-name))))
+ (with-parsed-tramp-file-name tramp-filename nil
+ (list host localname))))
+ (docker-container-assert-tramp-docker)
+ (dired (format "/%s:%s:%s" docker-container-tramp-method container directory)))
+
+(defalias 'docker-container-dired 'docker-container-find-directory)
+
+;;;###autoload (autoload 'docker-container-find-file "docker-container" nil t)
+(defun docker-container-find-file (container file)
+ "Open FILE inside CONTAINER."
+ (interactive
+ (let* ((container-name (docker-container-read-name))
+ (tramp-filename (read-file-name "File: " (format "/%s:%s:/" docker-container-tramp-method container-name))))
+ (with-parsed-tramp-file-name tramp-filename nil
+ (list host localname))))
+ (docker-container-assert-tramp-docker)
+ (find-file (format "/%s:%s:%s" docker-container-tramp-method container file)))
+
+;;;###autoload (autoload 'docker-container-shell "docker-container" nil t)
+(defun docker-container-shell (container &optional read-shell)
+ "Open `shell' in CONTAINER. When READ-SHELL is not nil, ask the user for it."
+ (interactive (list
+ (docker-container-read-name)
+ current-prefix-arg))
+ (let* ((shell-file-name (docker-container--read-shell read-shell))
+ (container-address (format "%s:%s:/" docker-container-tramp-method container))
+ (file-prefix (let ((prefix (file-remote-p default-directory)))
+ (if prefix
+ (format "%s|" (s-chop-suffix ":" prefix))
+ "/")))
+ (default-directory (format "%s%s" file-prefix container-address)))
+ (shell (docker-utils-generate-new-buffer "docker" "shell:" default-directory))))
+
+;;;###autoload (autoload 'docker-container-shell-env "docker-container" nil t)
+(aio-defun docker-container-shell-env (container &optional read-shell)
+ "Open `shell' in CONTAINER with the environment variable set
+and default directory set to workdir. When READ-SHELL is not
+nil, ask the user for it."
+ (interactive (list
+ (docker-container-read-name)
+ current-prefix-arg))
+ (docker-container-assert-tramp-docker)
+ (let* ((shell-file-name (docker-container--read-shell read-shell))
+ (container-address (format "%s:%s:" docker-container-tramp-method container))
+ (file-prefix (let ((prefix (file-remote-p default-directory)))
+ (if prefix
+ (format "%s|" (s-chop-suffix ":" prefix))
+ "/")))
+ (container-config (cdr (assq 'Config (aref (json-read-from-string (aio-await (docker-run-docker-async "inspect" container))) 0))))
+ (container-workdir (cdr (assq 'WorkingDir container-config)))
+ (container-env (cdr (assq 'Env container-config)))
+ (default-directory (format "%s%s%s" file-prefix container-address container-workdir))
+ ;; process-environment doesn't work with tramp if you call this function more than one per emacs session
+ (tramp-remote-process-environment (append container-env nil)))
+ (shell (docker-utils-generate-new-buffer "docker" "shell-env:" default-directory))))
+
+;;;###autoload (autoload 'docker-container-vterm "docker-container" nil t)
+(defun docker-container-vterm (container)
+ "Open `vterm' in CONTAINER."
+ (interactive (list (docker-container-read-name)))
+ (if (fboundp 'vterm-other-window)
+ (let* ((container-address (format "%s:%s:/" docker-container-tramp-method container))
+ (file-prefix (let ((prefix (file-remote-p default-directory)))
+ (if prefix
+ (format "%s|" (s-chop-suffix ":" prefix))
+ "/")))
+ (default-directory (format "%s%s" file-prefix container-address)))
+ (vterm-other-window (docker-utils-generate-new-buffer-name "docker" "vterm:" default-directory)))
+ (error "The vterm package is not installed")))
+
+;;;###autoload (autoload 'docker-container-vterm-env "docker-container" nil t)
+(aio-defun docker-container-vterm-env (container)
+ "Open `vterm' in CONTAINER with the environment variable set and
+default directory set to workdir."
+ (interactive (list
+ (docker-container-read-name)))
+ (docker-container-assert-tramp-docker)
+ (let* ((container-address (format "%s:%s:" docker-container-tramp-method container))
+ (file-prefix (let ((prefix (file-remote-p default-directory)))
+ (if prefix
+ (format "%s|" (s-chop-suffix ":" prefix))
+ "/")))
+ (container-config (cdr (assq 'Config (aref (json-read-from-string (aio-await (docker-run-docker-async "inspect" container))) 0))))
+ (container-workdir (cdr (assq 'WorkingDir container-config)))
+ (container-env (cdr (assq 'Env container-config)))
+ (default-directory (format "%s%s%s" file-prefix container-address container-workdir))
+ ;; process-environment doesn't work with tramp if you call this function more than one per emacs session
+ (tramp-remote-process-environment (append container-env nil)))
+ (if (fboundp 'vterm-other-window)
+ (vterm-other-window (docker-utils-generate-new-buffer-name "docker" "vterm-env:" default-directory))
+ (error "The vterm package is not installed"))))
+
+(defvar eat-buffer-name)
+
+;;;###autoload (autoload 'docker-container-eat "docker-container" nil t)
+(defun docker-container-eat (container)
+ "Open `eat' in CONTAINER."
+ (interactive (list (docker-container-read-name)))
+ (if (fboundp 'eat-other-window)
+ (let* ((container-address (format "%s:%s:/" docker-container-tramp-method container))
+ (file-prefix (let ((prefix (file-remote-p default-directory)))
+ (if prefix
+ (format "%s|" (s-chop-suffix ":" prefix))
+ "/")))
+ (default-directory (format "%s%s" file-prefix container-address))
+ (eat-buffer-name (format "*eat:%s" default-directory)))
+ (eat-other-window))
+ (error "The eat package is not installed")))
+
+;;;###autoload (autoload 'docker-container-eat-env "docker-container" nil t)
+(aio-defun docker-container-eat-env (container)
+ "Open `eat' in CONTAINER with the environment variable set and
+default directory set to workdir."
+ (interactive (list
+ (docker-container-read-name)))
+ (docker-container-assert-tramp-docker)
+ (let* ((container-address (format "%s:%s:" docker-container-tramp-method container))
+ (file-prefix (let ((prefix (file-remote-p default-directory)))
+ (if prefix
+ (format "%s|" (s-chop-suffix ":" prefix))
+ "/")))
+ (container-config (cdr (assq 'Config (aref (json-read-from-string (aio-await (docker-run-docker-async "inspect" container))) 0))))
+ (container-workdir (cdr (assq 'WorkingDir container-config)))
+ (container-env (cdr (assq 'Env container-config)))
+ (default-directory (format "%s%s%s" file-prefix container-address container-workdir))
+ ;; process-environment doesn't work with tramp if you call this function more than one per emacs session
+ (tramp-remote-process-environment (append container-env nil))
+ (eat-buffer-name (format "*eat-env:%s" default-directory)))
+ (if (fboundp 'eat-other-window)
+ (eat-other-window)
+ (error "The eat package is not installed"))))
+
+(defun docker-container-cp-from-selection (container-path host-path)
+ "Run \"docker cp\" from CONTAINER-PATH to HOST-PATH for selected container."
+ (interactive "sContainer path: \nFHost path: ")
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-run-docker-async "cp" (concat it ":" container-path) host-path)))
+
+(defun docker-container-cp-to-selection (host-path container-path)
+ "Run \"docker cp\" from HOST-PATH to CONTAINER-PATH for selected containers."
+ (interactive "fHost path: \nsContainer path: ")
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-run-docker-async "cp" host-path (concat it ":" container-path))))
+
+(defun docker-container-eshell-selection ()
+ "Run `docker-container-eshell' on the containers selection."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-eshell it)))
+
+(defun docker-container-find-directory-selection (path)
+ "Run `docker-container-find-directory' for PATH on the containers selection."
+ (interactive "sPath: ")
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-find-directory it path)))
+
+(defun docker-container-find-file-selection (path)
+ "Run `docker-container-find-file' for PATH on the containers selection."
+ (interactive "sPath: ")
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-find-file it path)))
+
+(aio-defun docker-container-rename-selection ()
+ "Rename containers."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (aio-await (docker-run-docker-async "rename" it (read-string (format "Rename \"%s\" to: " it)))))
+ (tablist-revert))
+
+(defun docker-container-shell-selection (prefix)
+ "Run `docker-container-shell' on the containers selection forwarding PREFIX."
+ (interactive "P")
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-shell it prefix)))
+
+(defun docker-container-shell-env-selection (prefix)
+ "Run `docker-container-shell-env' on the containers selection forwarding PREFIX."
+ (interactive "P")
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-shell-env it prefix)))
+
+(defun docker-container-vterm-selection ()
+ "Run `docker-container-vterm' on the containers selection."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-vterm it)))
+
+(defun docker-container-vterm-env-selection ()
+ "Run `docker-container-vterm-env' on the containers selection."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-vterm-env it)))
+
+(defun docker-container-shell-command (container)
+ "Run exec of a CONTAINER."
+ (interactive (list (docker-container-read-name)))
+ (shell-command (read-shell-command "Run: " (format "docker exec %s " container))))
+
+(defun docker-container-shell-command-selection ()
+ "Run `docker exec' on the containers selection."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-shell-command it)))
+
+(defun docker-container-eat-selection ()
+ "Run `docker-container-eat' on the containers selection."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-eat it)))
+
+(defun docker-container-eat-env-selection ()
+ "Run `docker-container-eat-env' on the containers selection."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-container-eat-env it)))
+
+(docker-utils-transient-define-prefix docker-container-attach ()
+ "Transient for attaching to containers."
+ :man-page "docker-container-attach"
+ ["Arguments"
+ ("n" "No STDIN" "--no-stdin")
+ ("d" "Key sequence for detaching" "--detach-keys " read-string)]
+ [:description docker-generic-action-description
+ ("a" "Attach" docker-generic-action-with-buffer)])
+
+(docker-utils-transient-define-prefix docker-container-cp ()
+ "Transient for copying files from/to containers."
+ :man-page "docker-container-cp"
+ [:description docker-generic-action-description
+ ("f" "Copy From" docker-container-cp-from-selection)
+ ("t" "Copy To" docker-container-cp-to-selection)])
+
+(docker-utils-transient-define-prefix docker-container-diff ()
+ "Transient for showing containers diffs."
+ :man-page "docker-container-diff"
+ [:description docker-generic-action-description
+ ("d" "Diff" docker-generic-action-with-buffer)])
+
+(docker-utils-transient-define-prefix docker-container-open ()
+ "Transient for opening containers files."
+ [:description docker-generic-action-description
+ ("d" "Open directory" docker-container-find-directory-selection)
+ ("f" "Open file" docker-container-find-file-selection)])
+
+(docker-utils-transient-define-prefix docker-container-kill ()
+ "Transient for kill signaling containers"
+ :man-page "docker-container-kill"
+ ["Arguments"
+ ("s" "Signal" "-s " read-string)]
+ [:description docker-generic-action-description
+ ("K" "Kill" docker-generic-action-multiple-ids)])
+
+(docker-utils-transient-define-prefix docker-container-logs ()
+ "Transient for showing containers logs."
+ :man-page "docker-container-logs"
+ ["Arguments"
+ ("f" "Follow" "-f")
+ ("s" "Since" "--since " read-string)
+ ("t" "Tail" "--tail " read-string)
+ ("u" "Until" "--until " read-string)]
+ [:description docker-generic-action-description
+ ("L" "Logs" docker-generic-action-with-buffer)])
+
+(docker-utils-define-transient-arguments docker-container-ls)
+
+(transient-define-prefix docker-container-ls ()
+ "Transient for listing containers."
+ :man-page "docker-container-ls"
+ :value '("--all")
+ ["Arguments"
+ ("N" "Last" "--last " transient-read-number-N0)
+ ("a" "All" "--all")
+ ("e" "Exited containers" "--filter status=exited")
+ ("f" "Filter" "--filter " read-string)
+ ("n" "Don't truncate" "--no-trunc")]
+ ["Actions"
+ ("l" "List" tablist-revert)])
+
+(docker-utils-transient-define-prefix docker-container-pause ()
+ "Transient for pausing containers."
+ :man-page "docker-container-pause"
+ [:description docker-generic-action-description
+ ("P" "Pause" docker-generic-action-multiple-ids)])
+
+(docker-utils-transient-define-prefix docker-container-unpause ()
+ "Transient for pausing containers."
+ :man-page "docker-container-unpause"
+ [:description docker-generic-action-description
+ ("N" "Unpause" docker-generic-action-multiple-ids)])
+
+(docker-utils-transient-define-prefix docker-container-restart ()
+ "Transient for restarting containers."
+ :man-page "docker-container-restart"
+ ["Arguments"
+ ("t" "Timeout" "-t " transient-read-number-N0)]
+ [:description docker-generic-action-description
+ ("R" "Restart" docker-generic-action-multiple-ids)])
+
+(docker-utils-transient-define-prefix docker-container-rm ()
+ "Transient for removing containers."
+ :man-page "docker-container-rm"
+ ["Arguments"
+ ("f" "Force" "-f")
+ ("v" "Volumes" "-v")]
+ [:description docker-generic-action-description
+ ("D" "Remove" docker-generic-action-multiple-ids)])
+
+(docker-utils-transient-define-prefix docker-container-shells ()
+ "Transient for using shells on containers."
+ [:description docker-generic-action-description
+ ("!" "Shell command" docker-container-shell-command-selection)
+ ("b" "Shell" docker-container-shell-selection)
+ ("B" "Shell with env" docker-container-shell-env-selection)
+ ("e" "Eshell" docker-container-eshell-selection)
+ ("v" "Vterm" docker-container-vterm-selection)
+ ("V" "Vterm with env" docker-container-vterm-env-selection)
+ ("a" "Eat" docker-container-eat-selection)
+ ("A" "Eat with env" docker-container-eat-env-selection)])
+
+(docker-utils-transient-define-prefix docker-container-start ()
+ "Transient for starting containers."
+ :man-page "docker-container-start"
+ [:description docker-generic-action-description
+ ("S" "Start" docker-generic-action-multiple-ids)])
+
+(docker-utils-transient-define-prefix docker-container-stop ()
+ "Transient for stoping containers."
+ :man-page "docker-container-stop"
+ ["Arguments"
+ ("t" "Timeout" "-t " transient-read-number-N0)]
+ [:description docker-generic-action-description
+ ("O" "Stop" docker-generic-action-multiple-ids)])
+
+(transient-define-prefix docker-container-help ()
+ "Help transient for docker containers."
+ ["Docker Containers"
+ ["Lifecycle"
+ ("K" "Kill" docker-container-kill)
+ ("O" "Stop" docker-container-stop)
+ ("N" "Unpause" docker-container-unpause)
+ ("P" "Pause" docker-container-pause)
+ ("R" "Restart" docker-container-restart)
+ ("S" "Start" docker-container-start)]
+ ["Admin"
+ ("C" "Copy" docker-container-cp)
+ ("D" "Remove" docker-container-rm)
+ ("I" "Inspect" docker-container-inspect)
+ ("L" "Logs" docker-container-logs)
+ ("a" "Attach" docker-container-attach)
+ ("b" "Shell" docker-container-shells)
+ ("d" "Diff" docker-container-diff)
+ ("f" "Find file" docker-container-open)
+ ("l" "List" docker-container-ls)
+ ("r" "Rename" docker-container-rename-selection)]])
+
+(defvar docker-container-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "?" 'docker-container-help)
+ (define-key map "C" 'docker-container-cp)
+ (define-key map "D" 'docker-container-rm)
+ (define-key map "I" 'docker-container-inspect)
+ (define-key map "K" 'docker-container-kill)
+ (define-key map "L" 'docker-container-logs)
+ (define-key map "O" 'docker-container-stop)
+ (define-key map "N" 'docker-container-unpause)
+ (define-key map "P" 'docker-container-pause)
+ (define-key map "R" 'docker-container-restart)
+ (define-key map "S" 'docker-container-start)
+ (define-key map "a" 'docker-container-attach)
+ (define-key map "b" 'docker-container-shells)
+ (define-key map "d" 'docker-container-diff)
+ (define-key map "f" 'docker-container-open)
+ (define-key map "l" 'docker-container-ls)
+ (define-key map "r" 'docker-container-rename-selection)
+ map)
+ "Keymap for `docker-container-mode'.")
+
+;;;###autoload (autoload 'docker-containers "docker-container" nil t)
+(defun docker-containers ()
+ "List docker containers."
+ (interactive)
+ (docker-utils-pop-to-buffer "*docker-containers*")
+ (docker-container-mode)
+ (tablist-revert))
+
+(define-derived-mode docker-container-mode tabulated-list-mode "Containers Menu"
+ "Major mode for handling a list of docker containers."
+ (setq tabulated-list-format (docker-utils-columns-list-format docker-container-columns))
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key docker-container-default-sort-key)
+ (add-hook 'tabulated-list-revert-hook 'docker-container-refresh nil t)
+ (tabulated-list-init-header)
+ (tablist-minor-mode))
+
+(provide 'docker-container)
+
+;;; docker-container.el ends here
--- /dev/null
+;;; docker-context.el --- Interface to docker-context -*- lexical-binding: t -*-
+
+;; Author: Pablo González Carrizo <unmonoquetecleaNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+(require 'json)
+(require 'tablist)
+(require 'transient)
+
+(require 'docker-core)
+(require 'docker-faces)
+(require 'docker-utils)
+
+(defgroup docker-context nil
+ "Docker context customization group."
+ :group 'docker)
+
+(defconst docker-context-id-template
+ "{{ json .Name }}"
+ "This Go template extracts the context id which will be passed to transient commands.")
+
+(defcustom docker-context-default-sort-key '("Name" . nil)
+ "Sort key for docker contexts.
+
+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-context
+ :type '(cons (string :tag "Column Name"
+ :validate (lambda (widget)
+ (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-context-columns)
+ (widget-put widget :error "Default Sort Key must match a column name")
+ widget)))
+ (choice (const :tag "Ascending" nil)
+ (const :tag "Descending" t))))
+
+(defcustom docker-context-columns
+ '((:name "Name" :width 40 :template "{{ json .Name }}" :sort nil :format nil)
+ (:name "Description" :width 40 :template "{{ json .Description }}" :sort nil :format nil)
+ (:name "Endpoint" :width 40 :template "{{ json .DockerEndpoint }}" :sort nil :format nil))
+ "Column specification for docker contexts.
+
+The order of entries defines the displayed column order.
+'Template' is the Go template passed to `docker-context-ls' to create the column
+data. It should return a string delimited with double quotes.
+'Sort function' is a binary predicate that should return true when the first
+argument should be sorted before the second.
+'Format function' is a function from string to string that transforms the
+displayed values in the column."
+ :group 'docker-context
+ :set 'docker-utils-columns-setter
+ :get 'docker-utils-columns-getter
+ :type '(repeat (list :tag "Column"
+ (string :tag "Name")
+ (integer :tag "Width")
+ (string :tag "Template")
+ (sexp :tag "Sort function")
+ (sexp :tag "Format function"))))
+
+(aio-defun docker-context-inspect ()
+ "Run \"`docker-command' context inspect\" on the selected items."
+ (interactive)
+ (docker-inspect "context"))
+
+(aio-defun docker-context-entries (&rest args)
+ "Return the docker contexts data for `tabulated-list-entries'."
+ (let* ((fmt (docker-utils-make-format-string docker-context-id-template docker-context-columns))
+ (data (aio-await (docker-run-docker-async "context" "ls" args (format "--format=\"%s\"" fmt))))
+ (lines (s-split "\n" data t)))
+ (-map (-partial #'docker-utils-parse docker-context-columns) lines)))
+
+(aio-defun docker-context-active-name (&rest args)
+ (let* ((fmt "{{ json .Current }} {{ json .Name }}")
+ (data (aio-await (docker-run-docker-async "context" "ls" args (format "--format=\"%s\"" fmt))))
+ (lines (s-split "\n" data t))
+ (active-line (-first (lambda (line) (string-match-p "true" (car (s-split " " line)))) lines)))
+ (when active-line
+ (cadr (split-string active-line "\"")))))
+
+(aio-defun docker-context-entries-propertized (&rest args)
+ "Return the propertized docker contexts data for `tabulated-list-entries'."
+ (let ((entries (aio-await (docker-context-entries args)))
+ (active (aio-await (docker-context-active-name args))))
+ (--map-when (string= active (car it)) (docker-context-entry-set-active it) entries)))
+
+(defun docker-context-entry-set-active (entry)
+ "Mark ENTRY (output of `docker-context-entries') as active.
+
+The result is the tabulated list id for an entry is propertized with
+'docker-context-active and the entry is fontified with 'docker-face-active."
+ (list (propertize (car entry) 'docker-context-active t)
+ (apply #'vector (--map (propertize it 'font-lock-face 'docker-face-active) (cadr entry)))))
+
+
+(aio-defun docker-context-update-status-async ()
+ "Write the status to `docker-status-strings'."
+ (plist-put docker-status-strings :contexts "Contexts")
+ (when (or (eq docker-show-status t) (and (eq docker-show-status 'local-only) (not (file-remote-p default-directory))))
+ (let* ((entries (aio-await (docker-context-entries-propertized (docker-context-ls-arguments)))))
+ (plist-put docker-status-strings
+ :contexts
+ (format "Context (%s total)" (number-to-string (length entries))))
+ (transient--redisplay))))
+
+(add-hook 'docker-open-hook #'docker-context-update-status-async)
+
+(aio-defun docker-context-refresh ()
+ "Refresh the contexts list."
+ (docker-utils-refresh-entries
+ (docker-context-entries-propertized (docker-context-ls-arguments))))
+
+(docker-utils-define-transient-arguments docker-context-ls)
+
+(docker-utils-transient-define-prefix docker-context-rm ()
+ "Transient for removing contexts."
+ :man-page "docker-context-rm"
+ [:description docker-generic-action-description
+ ("D" "Remove" docker-generic-action-multiple-ids)])
+
+(docker-utils-transient-define-prefix docker-context-use ()
+ "Transient for using contexts."
+ :man-page "docker-context-use"
+ [:description docker-generic-action-description
+ ("X" "Use" docker-generic-action)])
+
+(transient-define-prefix docker-context-help ()
+ "Help transient for docker contexts."
+ ["Docker contexts help"
+ ("D" "Remove" docker-context-rm)
+ ("I" "Inspect" docker-context-inspect)
+ ("X" "Use" docker-context-use)])
+
+(defvar docker-context-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "?" 'docker-context-help)
+ (define-key map "D" 'docker-context-rm)
+ (define-key map "I" 'docker-context-inspect)
+ (define-key map "X" 'docker-context-use)
+ map)
+ "Keymap for `docker-context-mode'.")
+
+;;;###autoload (autoload 'docker-contexts "docker-context" nil t)
+(defun docker-contexts ()
+ "List docker contexts."
+ (interactive)
+ (docker-utils-pop-to-buffer "*docker-contexts*")
+ (docker-context-mode)
+ (tablist-revert))
+
+(define-derived-mode docker-context-mode tabulated-list-mode "Contexts Menu"
+ "Major mode for handling a list of docker contexts."
+ (setq tabulated-list-format (docker-utils-columns-list-format docker-context-columns))
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key docker-context-default-sort-key)
+ (add-hook 'tabulated-list-revert-hook 'docker-context-refresh nil t)
+ (tabulated-list-init-header)
+ (tablist-minor-mode))
+
+(provide 'docker-context)
+
+;;; docker-context.el ends here
--- /dev/null
+;;; docker-core.el --- Docker core -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 'aio)
+(require 'transient)
+
+(require 'docker-group)
+(require 'docker-utils)
+(require 'docker-process)
+
+(defcustom docker-command "docker"
+ "The docker binary."
+ :group 'docker
+ :type 'string)
+
+(defvar docker-open-hook ()
+ "Called when `docker' transient is opened.")
+
+(defvar docker-status-strings '(:containers "" :images "" :networks "" :volumes "" :contexts "")
+ "Plist of statuses for `docker' transient.")
+
+(defcustom docker-show-status 'local-only
+ "Whether to display docker status in the main transient buffer."
+ :group 'docker
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "Local Only" local-only)
+ (const :tag "Never" nil)))
+
+(defcustom docker-inspect-view-mode (if (fboundp 'json-mode) 'json-mode 'js-mode)
+ "Major mode used in `docker inspect' buffers."
+ :group 'docker
+ :type 'symbol)
+
+(defun docker-run-docker-async (&rest args)
+ "Execute \"`docker-command' ARGS\" and return a promise with the results."
+ (apply #'docker-run-async docker-command (docker-arguments) args))
+
+(defun docker-run-docker-async-with-buffer (&rest args)
+ "Execute \"`docker-command' ARGS\" and display the results in a buffer."
+ (apply #'docker-run-async-with-buffer docker-command (docker-arguments) args))
+
+(defun docker-get-transient-action ()
+ "Extract the action out of `transient-current-command'."
+ (s-replace "-" " " (s-chop-prefix "docker-" (symbol-name transient-current-command))))
+
+(defun docker-generic-action-description ()
+ "Make the actions description for the selected items."
+ (let ((items (s-join ", " (docker-utils-get-marked-items-ids))))
+ (format "%s %s"
+ (propertize "Actions on" 'face 'transient-heading)
+ (propertize items 'face 'transient-value))))
+
+(aio-defun docker-generic-action (action args)
+ "Run \"`docker-command' ACTION ARGS\" on each of the selected items."
+ (interactive (list (docker-get-transient-action)
+ (transient-args transient-current-command)))
+ (let* ((ids (docker-utils-get-marked-items-ids))
+ (promises (--map (docker-run-docker-async action args it) ids)))
+ (aio-await (aio-all promises))
+ (tablist-revert)))
+
+(aio-defun docker-generic-action-multiple-ids (action args)
+ "Same as `docker-generic-action', but group selection ids into a single command."
+ (interactive (list (docker-get-transient-action)
+ (transient-args transient-current-command)))
+ (aio-await (docker-run-docker-async action args (docker-utils-get-marked-items-ids)))
+ (tablist-revert))
+
+(defun docker-generic-action-with-buffer (action args)
+ "Run \"`docker-command' ACTION ARGS\" and print output to a new buffer."
+ (interactive (list (docker-get-transient-action)
+ (transient-args transient-current-command)))
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-run-docker-async-with-buffer (s-split " " action) args it)))
+
+(aio-defun docker-inspect (&optional subcmd)
+ "Run \"`docker-command' inspect\" on the selected items."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (let* ((id it)
+ (data (aio-await (docker-run-docker-async (concat (or subcmd "") " inspect") id))))
+ (docker-utils-with-buffer (format "inspect %s" id)
+ (insert data)
+ (funcall docker-inspect-view-mode)
+ (view-mode)))))
+
+(defun docker-read-log-level (prompt &rest _args)
+ "Read the docker log level using PROMPT."
+ (completing-read prompt '(debug info warn error fatal)))
+
+(defun docker-read-certificate (prompt &optional initial-input _history)
+ "Wrapper around `read-file-name' forwarding PROMPT and INITIAL-INPUT."
+ (read-file-name prompt nil nil t initial-input (apply-partially 'string-match ".*\\.pem")))
+
+(docker-utils-define-transient-arguments docker)
+
+;;;###autoload (autoload 'docker "docker" nil t)
+(transient-define-prefix docker ()
+ "Transient for docker."
+ :man-page "docker"
+ ["Arguments"
+ (5 "H" "Host" "--host " read-string)
+ (5 "Tt" "TLS" "--tls")
+ (5 "Tv" "TLS verify remote" "--tlsverify")
+ (5 "Ta" "TLS CA" "--tlscacert" docker-read-certificate)
+ (5 "Tc" "TLS certificate" "--tlscert" docker-read-certificate)
+ (5 "Tk" "TLS key" "--tlskey" docker-read-certificate)
+ (5 "l" "Log level" "--log-level " docker-read-log-level)]
+ ["Docker"
+ ("c" (lambda ()(plist-get docker-status-strings :containers)) docker-containers)
+ ("i" (lambda ()(plist-get docker-status-strings :images)) docker-images)
+ ("n" (lambda ()(plist-get docker-status-strings :networks)) docker-networks)
+ ("v" (lambda ()(plist-get docker-status-strings :volumes)) docker-volumes)
+ ("x" (lambda ()(plist-get docker-status-strings :contexts)) docker-contexts)]
+ ["Other"
+ ("C" "Compose" docker-compose)]
+ (interactive)
+ (run-hooks 'docker-open-hook)
+ (transient-setup 'docker))
+
+(provide 'docker-core)
+
+;;; docker-core.el ends here
--- /dev/null
+;;; docker-faces.el --- Docker faces -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'dash)
+
+(require 'docker-core)
+
+(defgroup docker-faces nil
+ "Docker faces customization group."
+ :group 'docker
+ :group 'faces)
+
+(defface docker-face-status-up
+ '((t :inherit success))
+ "Face used when the status is up."
+ :group 'docker-faces)
+
+(defface docker-face-status-down
+ '((t :inherit error))
+ "Face used when the status is down."
+ :group 'docker-faces)
+
+(defface docker-face-status-other
+ '((t :inherit warning))
+ "Face used when the status is not up/down."
+ :group 'docker-faces)
+
+(defface docker-face-dangling
+ '((t :inherit shadow))
+ "Face for dangling items."
+ :group 'docker-faces)
+
+(defface docker-face-active
+ '((t :inherit bold))
+ "Face for active items."
+ :group 'docker-faces)
+
+(provide 'docker-faces)
+
+;;; docker-faces.el ends here
--- /dev/null
+;;; docker-group.el --- Docker group -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(defgroup docker nil
+ "Docker customization group."
+ :group 'convenience)
+
+(provide 'docker-group)
+
+;;; docker-group.el ends here
--- /dev/null
+;;; docker-image.el --- Interface to docker-image -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+(require 'json)
+(require 'tablist)
+(require 'transient)
+
+(require 'docker-core)
+(require 'docker-faces)
+(require 'docker-utils)
+
+(defgroup docker-image nil
+ "Docker images customization group."
+ :group 'docker)
+
+(defconst docker-image-id-template
+ "[{{ json .Repository }},{{ json .Tag }},{{ json .ID }}]"
+ "This Go template defines what will be passed to transient commands.
+
+This value is processed by `docker-image-make-id'.")
+
+(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 (string :tag "Column Name"
+ :validate (lambda (widget)
+ (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-image-columns)
+ (widget-put widget :error "Default Sort Key must match a column name")
+ widget)))
+ (choice (const :tag "Ascending" nil)
+ (const :tag "Descending" t))))
+
+(defcustom docker-image-columns
+ '((:name "Repository" :width 30 :template "{{ json .Repository }}" :sort nil :format nil)
+ (:name "Tag" :width 20 :template "{{ json .Tag }}" :sort nil :format nil)
+ (:name "Id" :width 16 :template "{{ json .ID }}" :sort nil :format nil)
+ (:name "Created" :width 24 :template "{{ json .CreatedAt }}" :sort nil :format (lambda (x) (format-time-string "%F %T" (date-to-time x))))
+ (:name "Size" :width 10 :template "{{ json .Size }}" :sort docker-utils-human-size-predicate :format nil))
+ "Column specification for docker images.
+
+The order of entries defines the displayed column order.
+'Template' is the Go template passed to `docker-image-ls' to create the column
+data. It should return a string delimited with double quotes.
+'Sort function' is a binary predicate that should return true when the first
+argument should be sorted before the second.
+'Format function' is a function from string to string that transforms the
+displayed values in the column."
+ :group 'docker-image
+ :set 'docker-utils-columns-setter
+ :get 'docker-utils-columns-getter
+ :type '(repeat (list :tag "Column"
+ (string :tag "Name")
+ (integer :tag "Width")
+ (string :tag "Template")
+ (sexp :tag "Sort function")
+ (sexp :tag "Format function"))))
+
+(defcustom docker-image-run-default-args
+ '("-i" "-t" "--rm")
+ "Default infix args used when docker run is invoked.
+
+Note this can be overriden for specific images using
+`docker-image-run-custom-args'."
+ :group 'docker-image
+ :type '(repeat string))
+
+(make-obsolete-variable 'docker-run-default-args 'docker-image-run-default-args "Docker 2.1.0")
+
+(defcustom docker-image-run-custom-args
+ nil
+ "List which can be used to customize the default arguments for docker run.
+
+Its elements should be of the form (REGEX ARGS) where
+REGEX is a (string) regular expression and ARGS is a list of strings
+corresponding to arguments.
+
+Also note if you do not specify `docker-run-default-args', they will be ignored."
+ :type '(repeat (list string (repeat string))))
+
+(defalias 'docker-image-inspect 'docker-inspect)
+
+(defun docker-image-make-id (parsed-line)
+ "Fix the id string of the entry and return the fixed entry.
+
+PARSED-LINE is the output of `docker-utils-parse', the car is expected to
+be the list (repository tag id). See `docker-image-id-template'."
+ ;; This could be written as a complex go template,
+ ;; however the literal '<none>' causes havoc in the windows shell.
+ (-let* ((([repo tag id] rest) parsed-line)
+ (new-id (if (or (equal repo "<none>") (equal tag "<none>"))
+ id
+ (format "%s:%s" repo tag))))
+ (list new-id rest)))
+
+(aio-defun docker-image-entries (&rest args)
+ "Return the docker images data for `tabulated-list-entries'."
+ (let* ((fmt (docker-utils-make-format-string docker-image-id-template docker-image-columns))
+ (data (aio-await (docker-run-docker-async "image" "ls" args (format "--format=\"%s\"" fmt))))
+ (lines (s-split "\n" data t)))
+ (--map (docker-image-make-id (docker-utils-parse docker-image-columns it)) lines)))
+
+(aio-defun docker-image-entries-propertized (&rest args)
+ "Return the propertized docker images data for `tabulated-list-entries'."
+ (let ((entries (aio-await (docker-image-entries args)))
+ (dangling (aio-await (docker-image-entries args "--filter dangling=true"))))
+ (--map-when (-contains? dangling it) (docker-image-entry-set-dangling it) entries)))
+
+(defun docker-image-dangling-p (entry-id) ;
+ "Predicate for if ENTRY-ID is dangling.
+
+For example (docker-image-dangling-p (tabulated-list-get-id)) is t when the entry under point is dangling."
+ (get-text-property 0 'docker-image-dangling entry-id))
+
+(defun docker-image-entry-set-dangling (entry)
+ "Mark ENTRY (output of `docker-image-entries') as dangling.
+
+The result is the tabulated list id for an entry is propertized with
+'docker-image-dangling and the entry is fontified with 'docker-face-dangling."
+ (list (propertize (car entry) 'docker-image-dangling t)
+ (apply #'vector (--map (propertize it 'font-lock-face 'docker-face-dangling) (cadr entry)))))
+
+(aio-defun docker-image-update-status-async ()
+ "Write the status to `docker-status-strings'."
+ (plist-put docker-status-strings :images "Images")
+ (when (or (eq docker-show-status t) (and (eq docker-show-status 'local-only) (not (file-remote-p default-directory))))
+ (let* ((entries (aio-await (docker-image-entries-propertized (docker-image-ls-arguments))))
+ (dangling (--filter (docker-image-dangling-p (car it)) entries)))
+ (plist-put docker-status-strings
+ :images
+ (format "Images (%s total, %s dangling)"
+ (number-to-string (length entries))
+ (propertize (number-to-string (length dangling)) 'face 'docker-face-dangling)))
+ (transient--redisplay))))
+
+(add-hook 'docker-open-hook #'docker-image-update-status-async)
+
+(aio-defun docker-image-refresh ()
+ "Refresh the images list."
+ (docker-utils-refresh-entries
+ (docker-image-entries-propertized (docker-image-ls-arguments))))
+
+(defun docker-image-read-name ()
+ "Read an image name."
+ (completing-read "Image: " (-map #'car (aio-wait-for (docker-image-entries)))))
+
+;;;###autoload (autoload 'docker-image-pull-one "docker-image" nil t)
+(aio-defun docker-image-pull-one (name &optional all)
+ "Pull the image named NAME. If ALL is set, use \"-a\"."
+ (interactive (list (docker-image-read-name) current-prefix-arg))
+ (aio-await (docker-run-docker-async "pull" (when all "-a") name))
+ (tablist-revert))
+
+(defun docker-image-run-selection (command)
+ "Run \"docker image run\" with COMMAND on the images selection."
+ (interactive "sCommand: ")
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-run-docker-async-with-buffer "container" "run" (transient-args 'docker-image-run) it command)))
+
+(aio-defun docker-image-tag-selection ()
+ "Tag images."
+ (interactive)
+ (docker-utils-ensure-items)
+ (let* ((ids (docker-utils-get-marked-items-ids))
+ (promises (--map (docker-run-docker-async "tag" it (read-string (format "Tag for %s: " it))) ids)))
+ (aio-await (aio-all promises))
+ (tablist-revert)))
+
+(defun docker-image-mark-dangling ()
+ "Mark only the dangling images listed in *docker-images*.
+
+This clears any user marks first and respects any tablist filters
+applied to the buffer."
+ (interactive)
+ (switch-to-buffer "*docker-images*")
+ (tablist-unmark-all-marks)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (docker-image-dangling-p (tabulated-list-get-id))
+ (tablist-put-mark))
+ (forward-line))))
+
+(docker-utils-define-transient-arguments docker-image-ls)
+
+(transient-define-prefix docker-image-ls ()
+ "Transient for listing images."
+ :man-page "docker-image-ls"
+ ["Arguments"
+ ("a" "All" "--all")
+ ("d" "Dangling" "--filter dangling=true")
+ ("f" "Filter" "--filter " read-string)
+ ("n" "Don't truncate" "--no-trunc")]
+ ["Actions"
+ ("l" "List" tablist-revert)])
+
+(transient-define-prefix docker-image-pull ()
+ "Transient for pulling images."
+ :man-page "docker-image-pull"
+ ["Arguments"
+ ("a" "All" "-a")]
+ [:description docker-generic-action-description
+ ("F" "Pull selection" docker-generic-action)
+ ("N" "Pull a new image" docker-image-pull-one)])
+
+(docker-utils-transient-define-prefix docker-image-push ()
+ "Transient for pushing images."
+ :man-page "docker-image-push"
+ [:description docker-generic-action-description
+ ("P" "Push" docker-generic-action)])
+
+(docker-utils-transient-define-prefix docker-image-rm ()
+ "Transient for removing images."
+ :man-page "docker-image-rm"
+ ["Arguments"
+ ("-f" "Force" "-f")
+ ("-n" "Don't prune" "--no-prune")]
+ [:description docker-generic-action-description
+ ("D" "Remove" docker-generic-action-multiple-ids)])
+
+(defclass docker-run-prefix (transient-prefix) nil)
+
+(cl-defmethod transient-init-value ((obj docker-run-prefix))
+ "Helper that modify OBJ DOCKER-RUN-PREFIX to handle `docker-image-run-custom-args'."
+ (oset obj value
+ (let* ((images (tablist-get-marked-items))
+ (matched-args (let ((repo-name (caar images)))
+ (if repo-name
+ (--first (string-match (car it) repo-name)
+ docker-image-run-custom-args)
+ nil))))
+ (if matched-args
+ (cadr matched-args)
+ docker-image-run-default-args))))
+
+(docker-utils-transient-define-prefix docker-image-run ()
+ "Transient for running images."
+ :man-page "docker-image-run"
+ :class 'docker-run-prefix
+ ["Arguments"
+ ("D" "With display" "-v /tmp/.X11-unix:/tmp/.X11-unix -e DISPLAY")
+ ("M" "Mount volume" "--mount " read-string)
+ ("N" "Network" "--network " read-string)
+ ("P" "Privileged" "--privileged")
+ ("T" "Synchronize time" "-v /etc/localtime:/etc/localtime:ro")
+ ("W" "Web ports" "-p 80:80 -p 443:443 -p 8080:8080")
+ ("d" "Detach" "-d")
+ ("e" "Environment" "-e " read-string)
+ ("i" "Interactive" "-i")
+ ("l" "Link" "--link " read-string)
+ ("m" "Name" "--name " read-string)
+ ("n" "Entrypoint" "--entrypoint " read-string)
+ ("o" "Read only" "--read-only")
+ ("p" "Port" "-p " read-string)
+ ("r" "Remove container when it exits" "--rm")
+ ("t" "TTY" "-t")
+ ("u" "User" "-u " read-string)
+ ("v" "Volume" "-v " read-string)
+ ("w" "Workdir" "-w " read-string)]
+ [:description docker-generic-action-description
+ ("R" "Run" docker-image-run-selection)])
+
+(transient-define-prefix docker-image-help ()
+ "Help transient for docker images."
+ ["Docker images help"
+ ("D" "Remove" docker-image-rm)
+ ("F" "Pull" docker-image-pull)
+ ("I" "Inspect" docker-image-inspect)
+ ("P" "Push" docker-image-push)
+ ("R" "Run" docker-image-run)
+ ("T" "Tag" docker-image-tag-selection)
+ ("d" "Mark Dangling" docker-image-mark-dangling)
+ ("l" "List" docker-image-ls)])
+
+(defvar docker-image-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "?" 'docker-image-help)
+ (define-key map "D" 'docker-image-rm)
+ (define-key map "F" 'docker-image-pull)
+ (define-key map "I" 'docker-image-inspect)
+ (define-key map "P" 'docker-image-push)
+ (define-key map "R" 'docker-image-run)
+ (define-key map "T" 'docker-image-tag-selection)
+ (define-key map "d" 'docker-image-mark-dangling)
+ (define-key map "l" 'docker-image-ls)
+ map)
+ "Keymap for `docker-image-mode'.")
+
+;;;###autoload (autoload 'docker-images "docker-image" nil t)
+(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 (docker-utils-columns-list-format docker-image-columns))
+ (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
--- /dev/null
+;;; docker-network.el --- Interface to docker-network -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+(require 'json)
+(require 'tablist)
+(require 'transient)
+
+(require 'docker-core)
+(require 'docker-faces)
+(require 'docker-utils)
+
+(defgroup docker-network nil
+ "Docker network customization group."
+ :group 'docker)
+
+(defconst docker-network-id-template
+ "{{ json .ID }}"
+ "This Go template extracts the id which will be passed to transient commands.")
+
+(defcustom docker-network-default-sort-key '("Name" . nil)
+ "Sort key for docker networks.
+
+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-network
+ :type '(cons (string :tag "Column Name"
+ :validate (lambda (widget)
+ (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-network-columns)
+ (widget-put widget :error "Default Sort Key must match a column name")
+ widget)))
+ (choice (const :tag "Ascending" nil)
+ (const :tag "Descending" t))))
+
+(defcustom docker-network-columns
+ '((:name "Network ID" :width 20 :template "{{ json .ID }}" :sort nil :format nil)
+ (:name "Name" :width 50 :template "{{ json .Name }}" :sort nil :format nil)
+ (:name "Driver" :width 10 :template "{{ json .Driver }}" :sort nil :format nil)
+ (:name "Scope" :width 10 :template "{{ json .Scope }}" :sort nil :format nil))
+ "Column specification for docker networks.
+
+The order of entries defines the displayed column order.
+'Template' is the Go template passed to `docker-network-ls' to create the column
+data. It should return a string delimited with double quotes.
+'Sort function' is a binary predicate that should return true when the first
+argument should be sorted before the second.
+'Format function' is a function from string to string that transforms the
+displayed values in the column."
+ :group 'docker-network
+ :set 'docker-utils-columns-setter
+ :get 'docker-utils-columns-getter
+ :type '(repeat (list :tag "Column"
+ (string :tag "Name")
+ (integer :tag "Width")
+ (string :tag "Template")
+ (sexp :tag "Sort function")
+ (sexp :tag "Format function"))))
+
+(defalias 'docker-network-inspect 'docker-inspect)
+
+(aio-defun docker-network-entries (&rest args)
+ "Return the docker networks data for `tabulated-list-entries'."
+ (let* ((fmt (docker-utils-make-format-string docker-network-id-template docker-network-columns))
+ (data (aio-await (docker-run-docker-async "network" "ls" args (format "--format=\"%s\"" fmt))))
+ (lines (s-split "\n" data t)))
+ (-map (-partial #'docker-utils-parse docker-network-columns) lines)))
+
+(aio-defun docker-network-entries-propertized (&rest args)
+ "Return the propertized docker networks data for `tabulated-list-entries'."
+ (let ((entries (aio-await (docker-network-entries args)))
+ (dangling (aio-await (docker-network-entries args "--filter dangling=true"))))
+ (--map-when (-contains? dangling it) (docker-network-entry-set-dangling it) entries)))
+
+(defun docker-network-dangling-p (entry-id)
+ "Predicate for if ENTRY-ID is dangling.
+
+For example (docker-network-dangling-p (tabulated-list-get-id)) is t when the entry under point is dangling."
+ (get-text-property 0 'docker-network-dangling entry-id))
+
+(defun docker-network-entry-set-dangling (entry)
+ "Mark ENTRY (output of `docker-network-entries') as dangling.
+
+The result is the tabulated list id for an entry is propertized with
+'docker-network-dangling and the entry is fontified with 'docker-face-dangling."
+ (list (propertize (car entry) 'docker-network-dangling t)
+ (apply #'vector (--map (propertize it 'font-lock-face 'docker-face-dangling) (cadr entry)))))
+
+(aio-defun docker-network-update-status-async ()
+ "Write the status to `docker-status-strings'."
+ (plist-put docker-status-strings :networks "Networks")
+ (when (or (eq docker-show-status t) (and (eq docker-show-status 'local-only) (not (file-remote-p default-directory))))
+ (let* ((entries (aio-await (docker-network-entries-propertized (docker-network-ls-arguments))))
+ (dangling (--filter (docker-network-dangling-p (car it)) entries)))
+ (plist-put docker-status-strings
+ :networks
+ (format "Networks (%s total, %s dangling)"
+ (number-to-string (length entries))
+ (propertize (number-to-string (length dangling)) 'face 'docker-face-dangling)))
+ (transient--redisplay))))
+
+(add-hook 'docker-open-hook #'docker-network-update-status-async)
+
+(aio-defun docker-network-refresh ()
+ "Refresh the networks list."
+ (docker-utils-refresh-entries
+ (docker-network-entries-propertized (docker-network-ls-arguments))))
+
+(defun docker-network-read-name ()
+ "Read a network name."
+ (completing-read "Network: " (-map #'car (aio-wait-for (docker-network-entries)))))
+
+(defun docker-network-mark-dangling ()
+ "Mark only the dangling networks listed in *docker-networks*.
+
+This clears any user marks first and respects any tablist filters
+applied to the buffer."
+ (interactive)
+ (switch-to-buffer "*docker-networks*")
+ (tablist-unmark-all-marks)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (docker-network-dangling-p (tabulated-list-get-id))
+ (tablist-put-mark))
+ (forward-line))))
+
+(docker-utils-define-transient-arguments docker-network-ls)
+
+(transient-define-prefix docker-network-ls ()
+ "Transient for listing networks."
+ :man-page "docker-network-ls"
+ ["Arguments"
+ ("d" "Dangling" "--filter dangling=true")
+ ("f" "Filter" "--filter " read-string)
+ ("n" "Don't truncate" "--no-trunc")]
+ ["Actions"
+ ("l" "List" tablist-revert)])
+
+(docker-utils-transient-define-prefix docker-network-rm ()
+ "Transient for removing networks."
+ :man-page "docker-network-rm"
+ [:description docker-generic-action-description
+ ("D" "Remove" docker-generic-action-multiple-ids)])
+
+(transient-define-prefix docker-network-help ()
+ "Help transient for docker networks."
+ ["Docker networks help"
+ ("D" "Remove" docker-network-rm)
+ ("I" "Inspect" docker-network-inspect)
+ ("d" "Mark Dangling" docker-network-mark-dangling)
+ ("l" "List" docker-network-ls)])
+
+(defvar docker-network-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "?" 'docker-network-help)
+ (define-key map "D" 'docker-network-rm)
+ (define-key map "I" 'docker-network-inspect)
+ (define-key map "d" 'docker-network-mark-dangling)
+ (define-key map "l" 'docker-network-ls)
+ map)
+ "Keymap for `docker-network-mode'.")
+
+;;;###autoload (autoload 'docker-networks "docker-network" nil t)
+(defun docker-networks ()
+ "List docker networks."
+ (interactive)
+ (docker-utils-pop-to-buffer "*docker-networks*")
+ (docker-network-mode)
+ (tablist-revert))
+
+(define-derived-mode docker-network-mode tabulated-list-mode "Networks Menu"
+ "Major mode for handling a list of docker networks."
+ (setq tabulated-list-format (docker-utils-columns-list-format docker-network-columns))
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key docker-network-default-sort-key)
+ (add-hook 'tabulated-list-revert-hook 'docker-network-refresh nil t)
+ (tabulated-list-init-header)
+ (tablist-minor-mode))
+
+(provide 'docker-network)
+
+;;; docker-network.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "docker" "20251028.1026"
+ "Interface to Docker."
+ '((aio "1.0")
+ (dash "2.19.1")
+ (emacs "28.1")
+ (s "1.13.0")
+ (tablist "1.1")
+ (transient "0.4.3"))
+ :url "https://github.com/Silex/docker.el"
+ :commit "375e0ed45bb1edc655d9ae2943a09864bec1fcba"
+ :revdesc "375e0ed45bb1"
+ :keywords '("filename" "convenience")
+ :authors '(("Philippe Vaucher" . "philippe.vaucherNOSPAMgmail.com"))
+ :maintainers '(("Philippe Vaucher" . "philippe.vaucherNOSPAMgmail.com")))
--- /dev/null
+;;; docker-process.el --- Docker process -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+
+(require 'docker-group)
+(require 'docker-utils)
+
+(defcustom docker-run-as-root nil
+ "Run docker as root."
+ :group 'docker
+ :type 'boolean)
+
+(defcustom docker-show-messages t
+ "If non-nil `message' docker commands which are run."
+ :group 'docker
+ :type 'boolean)
+
+(defcustom docker-run-async-with-buffer-function (if (featurep 'vterm)
+ 'docker-run-async-with-buffer-vterm
+ 'docker-run-async-with-buffer-shell)
+ "Function used to run a program with a live buffer attached to it."
+ :group 'docker
+ :type 'symbol)
+
+
+(defmacro docker-with-sudo (&rest body)
+ "Ensure `default-directory' is set correctly according to `docker-run-as-root' then execute BODY."
+ (declare (indent defun))
+ `(let ((default-directory (if (and docker-run-as-root (not (file-remote-p default-directory)))
+ "/sudo::"
+ default-directory)))
+ ,@body))
+
+(defun docker-run-start-file-process-shell-command (program &rest args)
+ "Execute \"PROGRAM ARGS\" and return the process."
+ (docker-with-sudo
+ (let* ((process-args (-remove 's-blank? (-flatten args)))
+ (command (s-join " " (-insert-at 0 program process-args))))
+ (when docker-show-messages (message "Running: %s" command))
+ (start-file-process-shell-command command (apply #'docker-utils-generate-new-buffer-name program process-args) command))))
+
+(defun docker-run-async (program &rest args)
+ "Execute \"PROGRAM ARGS\" and return a promise with the results."
+ (let* ((process (apply #'docker-run-start-file-process-shell-command program args))
+ (promise (aio-promise)))
+ (set-process-query-on-exit-flag process nil)
+ (set-process-sentinel process (-partial #'docker-process-sentinel promise))
+ promise))
+
+(defun docker-run-async-with-buffer (program &rest args)
+ "Execute \"PROGRAM ARGS\" and display output in a new buffer."
+ (apply docker-run-async-with-buffer-function program args))
+
+(defun docker-run-async-with-buffer-shell (program &rest args)
+ "Execute \"PROGRAM ARGS\" and display output in a new `shell' buffer."
+ (let* ((process (apply #'docker-run-start-file-process-shell-command program args))
+ (buffer (process-buffer process)))
+ (set-process-query-on-exit-flag process nil)
+ (with-current-buffer buffer (shell-mode))
+ (set-process-filter process 'comint-output-filter)
+ (switch-to-buffer-other-window buffer)))
+
+(defun docker-run-async-with-buffer-vterm (program &rest args)
+ "Execute \"PROGRAM ARGS\" and display output in a new `vterm' buffer."
+ (defvar vterm-kill-buffer-on-exit)
+ (defvar vterm-shell)
+ (if (fboundp 'vterm-other-window)
+ (let* ((process-args (-remove 's-blank? (-flatten args)))
+ (vterm-shell (s-join " " (-insert-at 0 program process-args)))
+ (vterm-kill-buffer-on-exit nil))
+ (vterm-other-window
+ (apply #'docker-utils-generate-new-buffer-name program process-args)))
+ (error "The vterm package is not installed")))
+
+(defun docker-process-sentinel (promise process event)
+ "Sentinel that resolves the PROMISE using PROCESS and EVENT."
+ (when (memq (process-status process) '(exit signal))
+ (setq event (substring event 0 -1))
+ (if (not (string-equal event "finished"))
+ (error "Error running: \"%s\" (%s)" (process-name process) event)
+ (aio-resolve promise
+ (lambda ()
+ (when docker-show-messages
+ (message "Finished: %s" (process-name process)))
+ (run-with-timer 2 nil (lambda () (message nil)))
+ (with-current-buffer (process-buffer process)
+ (prog1 (buffer-substring-no-properties (point-min) (point-max))
+ (kill-buffer))))))))
+
+(provide 'docker-process)
+
+;;; docker-process.el ends here
--- /dev/null
+;;; docker-utils.el --- Random utilities -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+(require 'json)
+(require 'tramp)
+(require 'tablist)
+(require 'transient)
+
+(defun docker-utils-get-marked-items-ids ()
+ "Get the id part of `tablist-get-marked-items'."
+ (-map #'car (tablist-get-marked-items)))
+
+(defun docker-utils-ensure-items ()
+ "Ensure at least one item is selected."
+ (when (null (docker-utils-get-marked-items-ids))
+ (user-error "This action cannot be used in an empty list")))
+
+(defun docker-utils-generate-new-buffer-name (program &rest args)
+ "Wrapper around `generate-new-buffer-name' using PROGRAM and ARGS."
+ (generate-new-buffer-name (format "* %s %s *" program (s-join " " args))))
+
+(defun docker-utils-generate-new-buffer (program &rest args)
+ "Wrapper around `generate-new-buffer' using PROGRAM and ARGS."
+ (generate-new-buffer (apply #'docker-utils-generate-new-buffer-name program args)))
+
+(defmacro docker-utils-with-buffer (name &rest body)
+ "Wrapper around `with-current-buffer'.
+Execute BODY in a buffer named with the help of NAME."
+ (declare (indent defun))
+ `(with-current-buffer (docker-utils-generate-new-buffer "docker" ,name)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ ,@body
+ (setq buffer-read-only t)
+ (goto-char (point-min))
+ (pop-to-buffer (current-buffer))))
+
+(defmacro docker-utils-transient-define-prefix (name arglist &rest args)
+ "Wrapper around `transient-define-prefix' forwarding NAME, ARGLIST and ARGS and calling `docker-utils-ensure-items'."
+ `(transient-define-prefix ,name ,arglist
+ ,@args
+ (interactive)
+ (docker-utils-ensure-items)
+ (transient-setup ',name)))
+
+(defmacro docker-utils-define-transient-arguments (name)
+ "Define the transient arguments function using NAME that return the latest transient value or its default."
+ `(defun ,(intern (format "%s-arguments" name)) ()
+ ,(format "Return the latest used arguments in the `%s' transient." name)
+ (let ((history (alist-get ',name transient-history))
+ (default (transient-default-value (get ',name 'transient--prefix))))
+ (if (equal 0 (length history))
+ (car default)
+ (car history)))))
+
+(defmacro docker-utils-refresh-entries (promise)
+ "Update the current buffer with the results of PROMISE."
+ `(let ((buffer (current-buffer))
+ (entries (aio-await ,promise)))
+ (with-current-buffer buffer
+ (setq tabulated-list-entries entries)
+ (tabulated-list-print t))))
+
+(defvar docker-pop-to-buffer-action nil
+ "Action to use internally when `docker-utils-pop-to-buffer' calls `pop-to-buffer'.")
+
+(defun docker-utils-pop-to-buffer (name)
+ "Like `pop-to-buffer', but suffix NAME with the host if on a remote host."
+ (pop-to-buffer
+ (if (file-remote-p default-directory)
+ (with-parsed-tramp-file-name default-directory nil (concat name " - " host))
+ name)
+ docker-pop-to-buffer-action))
+
+(defun docker-utils-unit-multiplier (str)
+ "Return the correct multiplier for STR."
+ (expt 1024 (-elem-index (upcase str) '("B" "KB" "MB" "GB" "TB" "PB" "EB"))))
+
+(defun docker-utils-human-size-to-bytes (str)
+ "Parse STR and return size in bytes."
+ (let* ((parts (s-match "^\\([0-9\\.]+\\)\\([A-Z]+\\)?$" str))
+ (value (string-to-number (-second-item parts)))
+ (multiplier (docker-utils-unit-multiplier (-third-item parts))))
+ (* value multiplier)))
+
+(defun docker-utils-human-size-predicate (a b)
+ "Sort A and B by image size."
+ (< (docker-utils-human-size-to-bytes a) (docker-utils-human-size-to-bytes b)))
+
+(defun docker-utils-columns-list-format (columns-spec)
+ "Convert COLUMNS-SPEC (a list of plists) to 'tabulated-list-format', i.e. a vector of (name width sort-fn)."
+ (apply 'vector
+ (--map-indexed
+ (-let* (((&plist :name name :width width :sort sort-fn-inner) it)
+ (sort-fn (if sort-fn-inner
+ (let ((idx it-index)) ;; Rebind the closure var!
+ ;; Sort fn is called with (id [entries..])
+ ;; Extract the column value and pass to inner function
+ (-on sort-fn-inner (lambda (x) (elt (cadr x) idx))))
+ t)))
+ (list name width sort-fn))
+ columns-spec)))
+
+(defun docker-utils-make-format-string (id-template column-spec)
+ "Make the format string to pass to docker-ls commands.
+
+ID-TEMPLATE is the Go template used to extract the property that
+identifies the object (usually its id).
+COLUMN-SPEC is the value of docker-X-columns."
+ (let* ((templates (--map (plist-get it :template) column-spec))
+ (delimited (string-join templates ",")))
+ (format "[%s,%s]" id-template delimited)))
+
+(defun docker-utils-parse (column-specs line)
+ "Convert a LINE from \"docker ls\" to a `tabulated-list-entries' entry.
+
+LINE is expected to be a JSON formatted array, and COLUMN-SPECS is the relevant
+defcustom (e.g. `docker-image-columns`) used to apply any custom format functions."
+ (condition-case nil
+ (let* ((data (json-read-from-string line)))
+ ;; apply format function, if any
+ (--each-indexed
+ column-specs
+ (let ((fmt-fn (plist-get it :format))
+ (data-index (+ it-index 1)))
+ (when fmt-fn (aset data data-index (apply fmt-fn (list (aref data data-index)))))))
+
+ (list (aref data 0) (seq-drop data 1)))
+ (json-readtable-error
+ (error "Could not read following string as json:\n%s" line))))
+
+(defun docker-utils-columns-setter (sym new-value)
+ "Convert NEW-VALUE into a list of plists, then assign to SYM.
+
+If NEW-VALUE already looks like a list of plists, no conversion is performed and
+ NEW-VALUE is assigned to SYM unchanged. This is expected to be used as the
+value of :set in a defcustom."
+ (let ((is-plist (plist-member (car new-value) :name))
+ (new-value-plist (--map
+ (-interleave '(:name :width :template :sort :format) it)
+ new-value)))
+ (set sym (if is-plist new-value new-value-plist))))
+
+(defun docker-utils-columns-getter (sym)
+ "Convert the value of SYM for displaying in the customization menu.
+
+Just strips the plist symbols and returns only values.
+This has no effect on the actual value of the variable."
+ (--map
+ (-map (-partial #'plist-get it) '(:name :width :template :sort :format))
+ (symbol-value sym)))
+
+(defun docker-utils-package-p (package)
+ "Check if PACKAGE is available."
+ (or (featurep package)
+ (ignore-errors (require package))))
+
+(provide 'docker-utils)
+
+;;; docker-utils.el ends here
--- /dev/null
+;;; docker-volume.el --- Interface to docker-volume -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.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:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 's)
+(require 'aio)
+(require 'dash)
+(require 'json)
+(require 'tablist)
+(require 'transient)
+
+(require 'docker-core)
+(require 'docker-faces)
+(require 'docker-utils)
+
+(defgroup docker-volume nil
+ "Docker volume customization group."
+ :group 'docker)
+
+(defconst docker-volume-id-template
+ "{{ json .Name }}"
+ "This Go template extracts the volume id which will be passed to transient commands.")
+
+(defcustom docker-volume-default-sort-key '("Driver" . nil)
+ "Sort key for docker volumes.
+
+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-volume
+ :type '(cons (string :tag "Column Name"
+ :validate (lambda (widget)
+ (unless (--any-p (equal (plist-get it :name) (widget-value widget)) docker-volume-columns)
+ (widget-put widget :error "Default Sort Key must match a column name")
+ widget)))
+ (choice (const :tag "Ascending" nil)
+ (const :tag "Descending" t))))
+
+(defcustom docker-volume-columns
+ '((:name "Driver" :width 10 :template "{{ json .Driver }}" :sort nil :format nil)
+ (:name "Name" :width 40 :template "{{ json .Name }}" :sort nil :format nil))
+ "Column specification for docker volumes.
+
+The order of entries defines the displayed column order.
+'Template' is the Go template passed to `docker-volume-ls' to create the column
+data. It should return a string delimited with double quotes.
+'Sort function' is a binary predicate that should return true when the first
+argument should be sorted before the second.
+'Format function' is a function from string to string that transforms the
+displayed values in the column."
+ :group 'docker-volume
+ :set 'docker-utils-columns-setter
+ :get 'docker-utils-columns-getter
+ :type '(repeat (list :tag "Column"
+ (string :tag "Name")
+ (integer :tag "Width")
+ (string :tag "Template")
+ (sexp :tag "Sort function")
+ (sexp :tag "Format function"))))
+
+(defalias 'docker-volume-inspect 'docker-inspect)
+
+(aio-defun docker-volume-entries (&rest args)
+ "Return the docker volumes data for `tabulated-list-entries'."
+ (let* ((fmt (docker-utils-make-format-string docker-volume-id-template docker-volume-columns))
+ (data (aio-await (docker-run-docker-async "volume" "ls" args (format "--format=\"%s\"" fmt))))
+ (lines (s-split "\n" data t)))
+ (-map (-partial #'docker-utils-parse docker-volume-columns) lines)))
+
+(aio-defun docker-volume-entries-propertized (&rest args)
+ "Return the propertized docker volumes data for `tabulated-list-entries'."
+ (let ((entries (aio-await (docker-volume-entries args)))
+ (dangling (aio-await (docker-volume-entries args "--filter dangling=true"))))
+ (--map-when (-contains? dangling it) (docker-volume-entry-set-dangling it) entries)))
+
+(defun docker-volume-dangling-p (entry-id)
+ "Predicate for if ENTRY-ID is dangling.
+
+For example (docker-volume-dangling-p (tabulated-list-get-id)) is t when the entry under point is dangling."
+ (get-text-property 0 'docker-volume-dangling entry-id))
+
+(defun docker-volume-entry-set-dangling (entry)
+ "Mark ENTRY (output of `docker-volume-entries') as dangling.
+
+The result is the tabulated list id for an entry is propertized with
+'docker-volume-dangling and the entry is fontified with 'docker-face-dangling."
+ (list (propertize (car entry) 'docker-volume-dangling t)
+ (apply #'vector (--map (propertize it 'font-lock-face 'docker-face-dangling) (cadr entry)))))
+
+(aio-defun docker-volume-update-status-async ()
+ "Write the status to `docker-status-strings'."
+ (plist-put docker-status-strings :volumes "Volumes")
+ (when (or (eq docker-show-status t) (and (eq docker-show-status 'local-only) (not (file-remote-p default-directory))))
+ (let* ((entries (aio-await (docker-volume-entries-propertized (docker-volume-ls-arguments))))
+ (dangling (--filter (docker-volume-dangling-p (car it)) entries)))
+ (plist-put docker-status-strings
+ :volumes
+ (format "Volumes (%s total, %s dangling)"
+ (number-to-string (length entries))
+ (propertize (number-to-string (length dangling)) 'face 'docker-face-dangling)))
+ (transient--redisplay))))
+
+(add-hook 'docker-open-hook #'docker-volume-update-status-async)
+
+(aio-defun docker-volume-refresh ()
+ "Refresh the volumes list."
+ (docker-utils-refresh-entries
+ (docker-volume-entries-propertized (docker-volume-ls-arguments))))
+
+(defun docker-volume-read-name ()
+ "Read a volume name."
+ (completing-read "Volume: " (-map #'car (aio-wait-for (docker-volume-entries)))))
+
+;;;###autoload (autoload 'docker-volume-dired "docker-volume" nil t)
+(aio-defun docker-volume-dired (name)
+ "Enter `dired' in the volume named NAME."
+ (interactive (list (docker-volume-read-name)))
+ (let ((path (s-trim-right (aio-await (docker-run-docker-async "inspect" "-f" "\"{{ .Mountpoint }}\"" name)))))
+ (dired (format "/sudo::%s" path))))
+
+(defun docker-volume-dired-selection ()
+ "Run `docker-volume-dired' on the volumes selection."
+ (interactive)
+ (docker-utils-ensure-items)
+ (--each (docker-utils-get-marked-items-ids)
+ (docker-volume-dired it)))
+
+(defun docker-volume-mark-dangling ()
+ "Mark only the dangling volumes listed in *docker-volumes*.
+
+This clears any user marks first and respects any tablist filters
+applied to the buffer."
+ (interactive)
+ (switch-to-buffer "*docker-volumes*")
+ (tablist-unmark-all-marks)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (docker-volume-dangling-p (tabulated-list-get-id))
+ (tablist-put-mark))
+ (forward-line))))
+
+(docker-utils-define-transient-arguments docker-volume-ls)
+
+(transient-define-prefix docker-volume-ls ()
+ "Transient for listing volumes."
+ :man-page "docker-volume-ls"
+ ["Arguments"
+ ("d" "Dangling" "--filter dangling=true")
+ ("f" "Filter" "--filter " read-string)]
+ ["Actions"
+ ("l" "List" tablist-revert)])
+
+(docker-utils-transient-define-prefix docker-volume-rm ()
+ "Transient for removing volumes."
+ :man-page "docker-volume-rm"
+ [:description docker-generic-action-description
+ ("D" "Remove" docker-generic-action-multiple-ids)])
+
+(transient-define-prefix docker-volume-help ()
+ "Help transient for docker volumes."
+ ["Docker volumes help"
+ ("D" "Remove" docker-volume-rm)
+ ("I" "Inspect" docker-volume-inspect)
+ ("d" "Mark Dangling" docker-volume-mark-dangling)
+ ("f" "Dired" docker-volume-dired-selection)
+ ("l" "List" docker-volume-ls)])
+
+(defvar docker-volume-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "?" 'docker-volume-help)
+ (define-key map "D" 'docker-volume-rm)
+ (define-key map "I" 'docker-volume-inspect)
+ (define-key map "d" 'docker-volume-mark-dangling)
+ (define-key map "f" 'docker-volume-dired-selection)
+ (define-key map "l" 'docker-volume-ls)
+ map)
+ "Keymap for `docker-volume-mode'.")
+
+;;;###autoload (autoload 'docker-volumes "docker-volume" nil t)
+(defun docker-volumes ()
+ "List docker volumes."
+ (interactive)
+ (docker-utils-pop-to-buffer "*docker-volumes*")
+ (docker-volume-mode)
+ (tablist-revert))
+
+(define-derived-mode docker-volume-mode tabulated-list-mode "Volumes Menu"
+ "Major mode for handling a list of docker volumes."
+ (setq tabulated-list-format (docker-utils-columns-list-format docker-volume-columns))
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key docker-volume-default-sort-key)
+ (add-hook 'tabulated-list-revert-hook 'docker-volume-refresh nil t)
+ (tabulated-list-init-header)
+ (tablist-minor-mode))
+
+(provide 'docker-volume)
+
+;;; docker-volume.el ends here
--- /dev/null
+;;; docker.el --- Interface to Docker -*- lexical-binding: t -*-
+
+;; Author: Philippe Vaucher <philippe.vaucherNOSPAMgmail.com>
+;; URL: https://github.com/Silex/docker.el
+;; Keywords: filename, convenience
+;; Package-Version: 20251028.1026
+;; Package-Revision: 375e0ed45bb1
+;; Package-Requires: ((aio "1.0") (dash "2.19.1") (emacs "28.1") (s "1.13.0") (tablist "1.1") (transient "0.4.3"))
+
+;; 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:
+
+;; This package allows you to manipulate docker images, containers & more from Emacs.
+
+;;; Code:
+(eval-when-compile
+ (setq-local byte-compile-warnings '(not docstrings)))
+
+(require 'docker-compose)
+(require 'docker-container)
+(require 'docker-image)
+(require 'docker-network)
+(require 'docker-volume)
+(require 'docker-context)
+
+(provide 'docker)
+
+;;; docker.el ends here
--- /dev/null
+;;; docker-compose-mode-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from docker-compose-mode.el
+
+(autoload 'docker-compose-mode "docker-compose-mode" "\
+Major mode to edit docker-compose files.
+
+(fn)" t)
+(add-to-list 'auto-mode-alist '("docker-compose[^/]*\\.ya?ml\\'" . docker-compose-mode))
+(register-definition-prefixes "docker-compose-mode" '("docker-compose-"))
+\f
+;;; End of scraped data
+
+(provide 'docker-compose-mode-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; docker-compose-mode-autoloads.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "docker-compose-mode" "20200830.1336"
+ "Major mode for editing docker-compose files."
+ '((emacs "24.3")
+ (dash "2.12.0")
+ (yaml-mode "0.0.12"))
+ :url "https://github.com/meqif/docker-compose-mode"
+ :commit "abaa4f3aeb5c62d7d16e186dd7d77f4e846e126a"
+ :revdesc "abaa4f3aeb5c"
+ :keywords '("convenience"))
--- /dev/null
+;;; docker-compose-mode.el --- Major mode for editing docker-compose files -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017-2018 Ricardo Martins
+
+;; Author: Ricardo Martins
+;; URL: https://github.com/meqif/docker-compose-mode
+;; Package-Version: 20200830.1336
+;; Package-Revision: abaa4f3aeb5c
+;; Keywords: convenience
+;; Package-Requires: ((emacs "24.3") (dash "2.12.0") (yaml-mode "0.0.12"))
+
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+
+;;; Commentary:
+
+;; Major mode for editing docker-compose files, providing context-aware
+;; completion of docker-compose keys through completion-at-point-functions.
+;;
+;; The completions can be used with the completion system shipped with vanilla
+;; Emacs, and 3rd-party frontends like company-mode, autocomplete, and
+;; ido-at-point.
+;;
+;; By default, the keyword completion function detects the docker-compose
+;; version of the current buffer and suggests the appropriate keywords.
+;;
+;; See the README for more details.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'dash)
+
+(defgroup docker-compose nil
+ "Major mode for editing docker-compose files."
+ :group 'languages
+ :prefix "docker-compose-")
+
+(defcustom docker-compose-keywords
+ '(
+ ("1.0" ("^[a-zA-Z0-9._-]+$" ("build") ("cap_add") ("cap_drop") ("cgroup_parent") ("command") ("container_name") ("cpu_shares") ("cpu_quota") ("cpuset") ("devices") ("dns") ("dns_search") ("dockerfile") ("domainname") ("entrypoint") ("env_file") ("environment" (".+")) ("expose") ("extends" ("service") ("file")) ("extra_hosts" (".+")) ("external_links") ("hostname") ("image") ("ipc") ("labels" (".+")) ("links") ("log_driver") ("log_opt") ("mac_address") ("mem_limit") ("memswap_limit") ("mem_swappiness") ("net") ("pid") ("ports") ("privileged") ("read_only") ("restart") ("security_opt") ("shm_size") ("stdin_open") ("stop_signal") ("tty") ("ulimits" ("^[a-z]+$" ("hard") ("soft"))) ("user") ("volumes") ("volume_driver") ("volumes_from") ("working_dir")))
+ ("2.0" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("blkio_config" (&quoimits" ("^[a-z]+$" ("hard") ("soft"))) ("user") ("volumes") ("volume_driver") ("volumes_from") ("working_dir"))) ("networks" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("ipam" ("driver") ("config") ("options" ("^.+$"))) ("external" ("name")) ("internal"))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("external" ("name")))) ("^x-"))
+ ("2.1" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("blkio_config" ("device_re;("^.+$"))) ("external" ("name")) ("internal") ("enable_ipv6") ("labels" (".+")) ("name"))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("external" ("name")) ("labels" (".+")) ("name"))) ("^x-"))
+ ("2.2" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("blkio_config" ("device_read_bps") ("device_read_iops") ("device_write_bps") ("device_write_iops") ("weight") ("weight_device")) ("build" ("context") ("dockerfile") ("args" (".+"))&nbpv6") ("labels" (".+")) ("name"))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("external" ("name")) ("labels" (".+")) ("name"))) ("^x-"))
+ ("2.3" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("blkio_config" ("device_read_bps") ("device_read_iops") ("device_write_bps") ("device_write_iops") ("weight") ("weight_device")) ("build" ("context") ("dockerfile") ("args" (".+")) ("labels" (".+")) ("cache_from") ("network") ("target&nal" ("name")) ("internal") ("enable_ipv6") ("labels" (".+")) ("name"))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("external" ("name")) ("labels" (".+")) ("name"))) ("^x-"))
+ ("3.0" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("deploy" ("mode") ("replicas") ("labels" (".+")) ("update_config" ("parallelism") ("delay") ("failure_action") ("monitor") ("max_failure_ratio")) ("resources" ("limits" ("cpus") ("mesp;("soft"))) ("user") ("userns_mode") ("volumes") ("working_dir"))) ("networks" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("ipam" ("driver") ("config")) ("external" ("name")) ("internal") ("labels" (".+")))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("external" ("name")) ("labels" (".+")))))
+ ("3.1" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("deploy" ("mode") ("replicas") ("labels" (".+")) ")))) ("secrets" ("^[a-zA-Z0-9._-]+$" ("file") ("external" ("name")) ("labels" (".+")))))
+ ("3.2" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("deploy" ("mode") ("endpoint_mode") ("replicas") ("labels" (".+")) ("update_config" ("parallelism") ("delay") ("failure_action") ("monitor") ("max_failure_ratio")) ("resources" ("limits" ("cpus") ("memory")) ("reservations" ("cpus") ("memory"))) ("restart_policy" ("condition") ("delay") ("max_attempts") ("wng_dir"))) ("networks" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("ipam" ("driver") ("config")) ("external" ("name")) ("internal") ("attachable") ("labels" (".+")))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("external" ("name")) ("labels" (".+")))) ("secrets" ("^[a-zA-Z0-9._-]+$" ("file") ("external" ("name")) ("labels" (".+")))))
+ ("3.3" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("deploy" (&quxternal" ("name")) ("internal") ("attachable") ("labels" (".+")))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("driver") ("driver_opts" ("^.+$")) ("external" ("name")) ("labels" (".+")))) ("secrets" ("^[a-zA-Z0-9._-]+$" ("file") ("external" ("name")) ("labels" (".+")))) ("configs" ("^[a-zA-Z0-9._-]+$" ("file") ("external" ("name")) ("labels" (".+")))))
+ ("3.4" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("deploy" ("mode") ("endpoint_mode") ("rr") ("config")) ("external" ("name")) ("internal") ("attachable") ("labels" (".+")))) ("volumes" ("^[a-zA-Z0-9._-]+$" ("name") ("driver") ("driver_opts" ("^.+$")) ("external" ("name")) ("labels" (".+")))) ("secrets" ("^[a-zA-Z0-9._-]+$" ("file") ("external" ("name")) ("labels" (".+")))) ("configs" ("^[a-zA-Z0-9._-]+$" ("file") ("external" ("name")) ("labels" (".+")))) ("^x-"))
+ ("3.5" ("version") ("services" ("^[a-zA-Z0-9._-]+$"ot; ("name")) ("labels" (".+")))) ("^x-"))
+ ("3.6" ("version") ("services" ("^[a-zA-Z0-9._-]+$" ("deploy" ("mode") ("endpoint_mode") ("replicas") ("labels" (".+")) ("update_config" ("parallelism") ("delay") ("failure_action") ("monitor") ("max_failure_ratio") ("order")) ("resources" ("limits" ("cpus") ("memory")) ("reservations" ("cpus") ("memory") ("generic_resources"))) ("restart_policy" ("condition") ("delay") ("max_attempts") ("window")) ("placement;) ("file") ("external" ("name")) ("labels" (".+")))) ("configs" ("^[a-zA-Z0-9._-]+$" ("name") ("file") ("external" ("name")) ("labels" (".+")))) ("^x-")))
+ "Association list of docker-compose keywords for each version."
+ :type '(alist :key-type string :value-type (repeat string))
+ :group 'docker-compose)
+
+(defun docker-compose--find-version ()
+ "Find the version of the docker-compose file.
+It is assumed that files lacking an explicit 'version' key are
+version 1."
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "^version:\s*" (point-at-eol) t 1)
+ (when (looking-at "\\([\"']\\)\\([0-9]\\(?:\.[0-9]+\\(?:-\\w+\\)?\\)?\\)\\1$")
+ (match-string-no-properties 2))
+ "1.0")))
+
+(defun docker-compose--normalize-version (version)
+ "Normalize VERSION to conform to <major>.<minor>."
+ (if (string-match-p "^[0-9]$" version)
+ (concat version ".0")
+ version))
+
+(defun docker-compose--keywords-for-buffer ()
+ "Obtain keywords appropriate for the current buffer's docker-compose version.
+
+If the version is not present in `docker-compose-keywords', the
+final (most recent) entry in it is used."
+ (-when-let* ((version (-some-> (docker-compose--find-version)
+ (docker-compose--normalize-version))))
+ (cdr (or (assoc version docker-compose-keywords)
+ (car (last docker-compose-keywords))))))
+
+(defun docker-compose--post-completion (_string status)
+ "Execute actions after completing with candidate.
+Read the documentation for the `completion-extra-properties'
+variable for additional information about STRING and STATUS."
+ (when (eq status 'finished)
+ (insert ": ")))
+
+(defun docker-compose--find-context ()
+ "Return a list with the ancestor keys of the current point."
+ (save-excursion
+ (beginning-of-line)
+ (-let* ((keywords nil)
+ (previous-indentation (skip-chars-forward "\t "))
+ (current-indentation nil))
+ (cl-loop
+ do
+ (forward-line -1)
+ (setq current-indentation (skip-chars-forward "\t "))
+ (when (and (< current-indentation previous-indentation)
+ (looking-at "\\([a-zA-Z][a-zA-Z0-9_]+\\):"))
+ (setq previous-indentation current-indentation)
+ (push (match-string-no-properties 1) keywords))
+
+ until (or (= previous-indentation 0) (bobp)))
+ keywords)))
+
+(defun docker-compose--find-subtree (nodes tree)
+ "Search a TREE of keywords for the subtree matching a sequence of the parent NODES."
+ (if nodes
+ (-when-let* ((node (car nodes))
+ (subtree (--find (string-match-p (car it) node) tree)))
+ (docker-compose--find-subtree (cdr nodes) (cdr subtree)))
+ tree))
+
+(defun docker-compose--filter-candidates-tree (prefix tree)
+ "Return a list of candidate keywords matching a PREFIX in a keyword TREE."
+ (let ((candidates nil))
+ (dolist (subtree tree (nreverse candidates))
+ (when (string-prefix-p prefix (car subtree))
+ (push (car subtree) candidates)))))
+
+(defun docker-compose--candidates (prefix)
+ "Obtain applicable candidates from the keywords list for the PREFIX."
+ (-let* ((keywords (docker-compose--keywords-for-buffer))
+ (nodes (docker-compose--find-context))
+ (subtree (docker-compose--find-subtree nodes keywords)))
+ (if prefix
+ (docker-compose--filter-candidates-tree prefix subtree)
+ (-map #'car subtree))))
+
+(defun docker-compose--prefix ()
+ "Get a prefix and its starting and ending points from the current position."
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at "^[\t ]*\\([a-zA-Z][a-zA-Z0-9_]+\\)$")
+ (list (match-string-no-properties 1) (match-beginning 1) (match-end 1)))))
+
+(defun docker-compose-keyword-complete-at-point ()
+ "`completion-at-point-functions' function for docker-compose keywords."
+ (-when-let* (((prefix start end) (docker-compose--prefix)))
+ (list start end (docker-compose--candidates prefix)
+ :exclusive 'yes
+ :company-docsig #'identity
+ :exit-function #'docker-compose--post-completion)))
+
+(declare-function yaml-mode "ext:yaml-mode")
+
+;;;###autoload
+(define-derived-mode docker-compose-mode yaml-mode "docker-compose"
+ "Major mode to edit docker-compose files."
+ (setq-local completion-at-point-functions
+ '(docker-compose-keyword-complete-at-point)))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist
+ '("docker-compose[^/]*\\.ya?ml\\'" . docker-compose-mode))
+
+(provide 'docker-compose-mode)
+;;; docker-compose-mode.el ends here
projects / emacsconfig.git / commitdiff