procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'refs/remotes/origin/master'

Browse source
This commit is contained in:
Stefan Monnier 2022-09-24 11:09:25 -04:00
commit 4b85ae6a24
4 changed files with 213 additions and 169 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/emacs-lisp/cl-generic.el
View file

@ -94,11 +94,6 @@
;; This second one is closely related to what we do here (and that's
;; the name "generalizer" comes from).
;; The autoloads.el mechanism which adds package--builtin-versions
;; maintenance to loaddefs.el doesn't work for preloaded packages (such
;; as this one), so we have to do it by hand!
(push (purecopy '(cl-generic 1 0)) package--builtin-versions)
;; Note: For generic functions that dispatch on several arguments (i.e. those
;; which use the multiple-dispatch feature), we always use the same "tagcodes"
;; and the same set of arguments on which to dispatch. This works, but is

6
lisp/emacs-lisp/nadvice.el
View file

@ -4,6 +4,7 @@
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions, lisp, tools
;; Version: 1.0
;; This file is part of GNU Emacs.
@ -37,11 +38,6 @@
;;; Code:
;; The autoloads.el mechanism which adds package--builtin-versions
;; maintenance to loaddefs.el doesn't work for preloaded packages (such
;; as this one), so we have to do it by hand!
(push (purecopy '(nadvice 1 0)) package--builtin-versions)
(oclosure-define (advice
(:predicate advice--p)
(:copier advice--cons (cdr))

246
lisp/ldefs-boot.el
View file

@ -4312,79 +4312,6 @@ it is disabled.
;;; Generated autoloads from emacs-lisp/cl-generic.el
(push (purecopy '(cl-generic 1 0)) package--builtin-versions)
(autoload 'cl-defgeneric "cl-generic" "\
Create a generic function NAME.
DOC-STRING is the base documentation for this class. A generic
function has no body, as its purpose is to decide which method body
is appropriate to use. Specific methods are defined with `cl-defmethod'.
With this implementation the ARGS are currently ignored.
OPTIONS-AND-METHODS currently understands:
- (:documentation DOCSTRING)
- (declare DECLARATIONS)
- (:argument-precedence-order &rest ARGS)
- (:method [QUALIFIERS...] ARGS &rest BODY)
DEFAULT-BODY, if present, is used as the body of a default method.
(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)" nil t)
(function-put 'cl-defgeneric 'lisp-indent-function 2)
(function-put 'cl-defgeneric 'doc-string-elt 3)
(autoload 'cl-generic-define "cl-generic" "\
(fn NAME ARGS OPTIONS)")
(autoload 'cl-defmethod "cl-generic" "\
Define a new method for generic function NAME.
This defines an implementation of NAME to use for invocations
of specific types of arguments.
ARGS is a list of dispatch arguments (see `cl-defun'), but where
each variable element is either just a single variable name VAR,
or a list on the form (VAR TYPE).
For instance:
(cl-defmethod foo (bar (format-string string) &optional zot)
(format format-string bar))
The dispatch arguments have to be among the mandatory arguments, and
all methods of NAME have to use the same set of arguments for dispatch.
Each dispatch argument and TYPE are specified in ARGS where the corresponding
formal argument appears as (VAR TYPE) rather than just VAR.
The optional EXTRA element, on the form `:extra STRING', allows
you to add more methods for the same specializers and qualifiers.
These are distinguished by STRING.
The optional argument QUALIFIER is a specifier that modifies how
the method is combined with other methods, including:
:before - Method will be called before the primary
:after - Method will be called after the primary
:around - Method will be called around everything else
The absence of QUALIFIER means this is a \"primary\" method.
The set of acceptable qualifiers and their meaning is defined
(and can be extended) by the methods of `cl-generic-combine-methods'.
ARGS can also include so-called context specializers, introduced by
`&context' (which should appear right after the mandatory arguments,
before any &optional or &rest). They have the form (EXPR TYPE) where
EXPR is an Elisp expression whose value should match TYPE for the
method to be applicable.
The set of acceptable TYPEs (also called \"specializers\") is defined
(and can be extended) by the various methods of `cl-generic-generalizers'.
(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" nil t)
(function-put 'cl-defmethod 'doc-string-elt 'cl--defmethod-doc-pos)
(function-put 'cl-defmethod 'lisp-indent-function 'defun)
(autoload 'cl-generic-define-method "cl-generic" "\
(fn NAME QUALIFIERS ARGS CALL-CON FUNCTION)")
(autoload 'cl-find-method "cl-generic" "\
(fn GENERIC QUALIFIERS SPECIALIZERS)")
(register-definition-prefixes "cl-generic" '("cl-"))
;;; Generated autoloads from emacs-lisp/cl-indent.el
@ -9485,6 +9412,8 @@ Already submitted bugs can be found in the Emacs bug tracker:
(fn TOPIC &optional UNUSED)" t)
(set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5")
(autoload 'emacs-build-description "emacsbug" "\
Insert a description of the current Emacs build in the current buffer." t)
(autoload 'submit-emacs-patch "emacsbug" "\
Send an Emacs patch to the Emacs maintainers.
Interactively, you will be prompted for SUBJECT and a patch FILE
@ -9492,7 +9421,7 @@ name (which will be attached to the mail). You will end up in a
Message buffer where you can explain more about the patch.
(fn SUBJECT FILE)" t)
(register-definition-prefixes "emacsbug" '("emacs-bug--system-description" "report-emacs-bug-"))
(register-definition-prefixes "emacsbug" '("report-emacs-bug-"))
;;; Generated autoloads from vc/emerge.el
@ -16940,9 +16869,9 @@ should output the image in the current buffer, converted to
;;; Generated autoloads from image/image-crop.el
(autoload 'image-cut "image-crop" "\
Cut a rectangle from the image under point.
Interactively, if given a prefix, prompt for COLOR to use.
Otherwise, default to `image-cut-color'.
Cut a rectangle from the image under point, filling it with COLOR.
COLOR defaults to the value of `image-cut-color'.
Interactively, with prefix argument, prompt for COLOR to use.
(fn &optional COLOR)" t)
(autoload 'image-crop "image-crop" "\
@ -16968,7 +16897,7 @@ After cropping an image, you can save it by `M-x image-save' or
;;; Generated autoloads from image/image-dired.el
(push (purecopy '(image-dired 0 4 11)) package--builtin-versions)
(push (purecopy '(image-dired 0 5)) package--builtin-versions)
(autoload 'image-dired-dired-with-window-configuration "image-dired" "\
Open directory DIR and create a default window configuration.
@ -17012,8 +16941,8 @@ thumbnail buffer to be selected.
(fn &optional ARG APPEND DO-NOT-POP)" '(nil dired-mode))
(autoload 'image-dired-show-all-from-dir "image-dired" "\
Make a thumbnail buffer for all images in DIR and display it.
Any file matching `image-file-name-regexp' is considered an image
file.
Any file matching `image-dired--file-name-regexp' is considered an
image file.
If the number of image files in DIR exceeds
`image-dired-show-all-from-dir-max-files', ask for confirmation
@ -17044,10 +16973,30 @@ previous -ARG, if ARG<0) files.
(autoload 'image-dired-jump-thumbnail-buffer "image-dired-dired" "\
Jump to thumbnail buffer." '(dired-mode))
(autoload 'image-dired-minor-mode "image-dired-dired" "\
Setup easy-to-use keybindings for the commands to be used in Dired mode.
Setup easy-to-use keybindings for Image-Dired in Dired mode.
Note that n, p and <down> and <up> will be hijacked and bound to
`image-dired-dired-next-line' and `image-dired-dired-previous-line'.
This minor mode adds these additional bindings:
\\<image-dired-minor-mode-map>
\\[image-dired-next-line-and-display] Move to next line and display thumbnail image.
\\[image-dired-previous-line-and-display] Move to previous line and display thumbnail image.
\\[image-dired-mark-and-display-next] Mark current file and display next thumbnail image.
\\[image-dired-jump-thumbnail-buffer] Jump to thumbnail buffer.
For reference, these are the default Image-Dired bindings that
are always available in Dired:
\\<dired-mode-map>
\\[image-dired-display-thumbs] Display thumbnails of all marked files.
\\[image-dired-tag-files] Tag marked file(s).
\\[image-dired-delete-tag] Remove tag for selected file(s).
\\[image-dired-jump-thumbnail-buffer] Jump to thumbnail buffer.
\\[image-dired-dired-display-image] Display current image file.
\\[image-dired-dired-display-external] Display file at point using an external viewer.
\\[image-dired-display-thumbs-append] Append thumbnails to thumbnail buffer.
\\[image-dired-display-thumb] Display thumbnails of all marked files.
\\[image-dired-dired-comment-files] Add comment to current or marked files in Dired.
\\[image-dired-mark-tagged-files] Use REGEXP to mark files with matching tag.
\\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in front of file names.
\\[image-dired-dired-edit-comment-and-tags] Edit comment and tags of marked images.
This is a minor mode. If called interactively, toggle the
`Image-Dired minor mode' mode. If the prefix argument is
@ -18685,58 +18634,6 @@ sleep in seconds.
(fn &optional STEP-TIME)" t)
(register-definition-prefixes "life" '("life-"))
;;; Generated autoloads from linum.el
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
This mode has been largely replaced by `display-line-numbers-mode'
(which is much faster and has fewer interaction problems with other
modes).
Linum mode is a buffer-local minor mode.
This is a minor mode. If called interactively, toggle the `Linum
mode' mode. If the prefix argument is positive, enable the mode,
and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable
the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `linum-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
(fn &optional ARG)" t)
(put 'global-linum-mode 'globalized-minor-mode t)
(defvar global-linum-mode nil "\
Non-nil if Global Linum mode is enabled.
See the `global-linum-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-linum-mode'.")
(custom-autoload 'global-linum-mode "linum" nil)
(autoload 'global-linum-mode "linum" "\
Toggle Linum mode in all buffers.
With prefix ARG, enable Global Linum mode if ARG is positive;
otherwise, disable it.
If called from Lisp, toggle the mode if ARG is `toggle'.
Enable the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
Linum mode is enabled in all buffers where `linum-on' would do it.
See `linum-mode' for more information on Linum mode.
(fn &optional ARG)" t)
(register-definition-prefixes "linum" '("linum-"))
;;; Generated autoloads from cedet/ede/linux.el
@ -20985,6 +20882,11 @@ it is disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
;;; Generated autoloads from emacs-lisp/nadvice.el
(push (purecopy '(nadvice 1 0)) package--builtin-versions)
;;; Generated autoloads from net/net-utils.el
@ -22655,6 +22557,15 @@ Inserted by installing Org mode or when a release is made.")
The Git version of Org mode.
Inserted by installing Org or when a release is made.")
;;; Generated autoloads from osc.el
(autoload 'osc-compilation-filter "osc" "\
Maybe collect OSC control sequences.
This function depends on the variable `osc-for-compilation-buffer',
and is meant to be used in `compilation-filter-hook'.")
(register-definition-prefixes "osc" '("osc-"))
;;; Generated autoloads from outline.el
@ -26190,7 +26101,7 @@ Regexp to match Header fields that Rmail should display.
If nil, display all header fields except those matched by
`rmail-ignored-headers'.")
(custom-autoload 'rmail-displayed-headers "rmail" t)
(defvar rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:") "\
(defvar rmail-retry-ignored-headers (concat "^x-authentication-warning:\\|^x-detected-operating-system:\\|" "^x-spam[-a-z]*:\\|^arc-.*:\\|" "^content-type:\\|^content-transfer-encoding:\\|" "^mime-version:\\|^message-id:\\|^x-google-smtp-source:\\|" "^x-received:\\|^received-spf:\\|" "^authentication-results:\\|^dkim-signature:") "\
Headers that should be stripped when retrying a failed message.")
(custom-autoload 'rmail-retry-ignored-headers "rmail" t)
(defvar rmail-highlighted-headers (purecopy "^From:\\|^Subject:") "\
@ -29627,6 +29538,10 @@ Studlify-case the current buffer." t)
;;; Generated autoloads from emacs-lisp/subr-x.el
(defsubst string-join (strings &optional separator) "\
Join all STRINGS using SEPARATOR.
Optional argument SEPARATOR must be a string, a vector, or a list of
characters; nil stands for the empty string." (mapconcat #'identity strings separator))
(autoload 'string-truncate-left "subr-x" "\
If STRING is longer than LENGTH, return a truncated version.
When truncating, \"...\" is always prepended to the string, so
@ -31253,28 +31168,6 @@ Display a list of threads." t)
(put 'list-threads 'disabled "Beware: manually canceling threads can ruin your Emacs session.")
(register-definition-prefixes "thread" '("thread-list-"))
;;; Generated autoloads from thumbs.el
(autoload 'thumbs-find-thumb "thumbs" "\
Display the thumbnail for IMG.
(fn IMG)" t)
(autoload 'thumbs-show-from-dir "thumbs" "\
Make a preview buffer for all images in DIR.
Optional argument REG to select file matching a regexp,
and SAME-WINDOW to show thumbs in the same window.
(fn DIR &optional REG SAME-WINDOW)" t)
(autoload 'thumbs-dired-show-marked "thumbs" "\
In dired, make a thumbs buffer with marked files." t)
(autoload 'thumbs-dired-show "thumbs" "\
In dired, make a thumbs buffer with all files in current directory." t)
(defalias 'thumbs 'thumbs-show-from-dir)
(autoload 'thumbs-dired-setroot "thumbs" "\
In dired, call the setroot program on the image at point." t)
(register-definition-prefixes "thumbs" '("thumbs-"))
;;; Generated autoloads from emacs-lisp/thunk.el
@ -33505,8 +33398,11 @@ with its diffs (if the underlying VCS supports that).
(fn &optional LIMIT REVISION)" t)
(autoload 'vc-print-branch-log "vc" "\
Show the change log for BRANCH root in a window.
Optional prefix ARG non-nil requests an opportunity for the user
to edit the VC shell command that will be run to generate the
log.
(fn BRANCH)" t)
(fn BRANCH &optional ARG)" t)
(autoload 'vc-log-incoming "vc" "\
Show log of changes that will be received with pull from REMOTE-LOCATION.
When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
@ -33572,6 +33468,22 @@ VCS command to run.
On a non-distributed version control system, this signals an error.
It also signals an error in a Bazaar bound branch.
(fn &optional ARG)" t)
(autoload 'vc-pull-and-push "vc" "\
First pull, and then push the current branch.
The push will only be performed if the pull operation was successful.
You must be visiting a version controlled file, or in a `vc-dir' buffer.
On a distributed version control system, this runs a \"pull\"
operation on the current branch, prompting for the precise
command if required. Optional prefix ARG non-nil forces a prompt
for the VCS command to run. If this is successful, a \"push\"
operation will then be done.
On a non-distributed version control system, this signals an error.
It also signals an error in a Bazaar bound branch.
(fn &optional ARG)" t)
(autoload 'vc-switch-backend "vc" "\
Make BACKEND the current version control system for FILE.
@ -33740,6 +33652,10 @@ FILE-OR-LIST is the name of a working file; it may be a list of
files or be nil (to execute commands that don't expect a file
name or set of files). If an optional list of FLAGS is present,
that is inserted into the command line before the filename.
If `vc-want-edit-command-p' is non-nil, prompt the user to edit
COMMAND and FLAGS before execution.
Return the return value of the slave command in the synchronous
case, and the process object in the asynchronous case.
@ -34916,6 +34832,18 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'." t)
;;; Generated autoloads from image/wallpaper.el
(autoload 'wallpaper-set "wallpaper" "\
Set the desktop background to FILE in a graphical environment.
On GNU/Linux and other Unix-like systems, this relies on an
external command. Which command to use is automatically detected
in most cases, but can be manually customized with the user
options `wallpaper-command' and `wallpaper-command-args'.
On MS-Windows and Haiku systems, no external command is needed,
so the value of `wallpaper-commands' is ignored.
(fn FILE)" t)
(register-definition-prefixes "wallpaper" '("wallpaper-"))

125
lisp/net/tramp-docker.el Normal file
View file

@ -0,0 +1,125 @@
;;; tramp-docker.el --- Tramp integration for Docker containers -*- lexical-binding: t; -*-
;; Copyright © 2022 Free Software Foundation, Inc.
;; Author: Brian Cully <bjc@kublai.com>
;; Maintainer: Brian Cully <bjc@kublai.com>
;; URL: https://git.spork.org/tramp-docker
;; Keywords: tramp, docker
;; Version: 0.99.1
;; Package-Requires: ((emacs "23"))
;;; License:
;; 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 of the
;; License, 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; ‘tramp-docker’ allows Tramp access to environments provided by
;; Docker.
;;
;; ## Usage
;;
;; Call ‘tramp-docker-setup’ in your Emacs initialization.
;;
;; (add-hook 'after-init-hook 'tramp-docker-setup)
;;
;; Open a file on a running systemd-docker container:
;;
;; C-x C-f /docker:USER@CONTAINER:/path/to/file
;;
;; Where:
;; USER is the user on the container to connect as (optional)
;; CONTAINER is the container to connect to
;;
;;; Code:
(require 'tramp)
(defgroup tramp-docker nil
"Tramp integration for Docker containers."
:prefix "tramp-docker-"
:group 'applications
:link '(url-link :tag "repo" "https://git.spork.org/tramp-docker.git")
:link '(emacs-commentary-link :tag "Commentary" "tramp-docker"))
(defcustom tramp-docker-program "docker"
"Name of the Docker client program."
:type '(choice (const "docker")
(const "podman")
(string))
:group 'tramp-docker)
(defconst tramp-docker-method "docker"
"Tramp method name to use to connect to Docker containers.")
(defun tramp-docker--completion-function (&rest _args)
"List Docker containers available for connection.
This function is used by ‘tramp-set-completion-function’, please
see its function help for a description of the format."
(let* ((raw-list (shell-command-to-string
(concat tramp-docker-program
" ps --format '{{.ID}}\t{{.Names}}'")))
(lines (split-string raw-list "\n"))
(names (mapcar (lambda (line)
(let ((words (split-string line "\t")))
(or (nth 1 words) (nth 0 words))))
lines))
(machines (seq-take-while (lambda (name) name) names)))
(mapcar (lambda (m) (list nil m)) machines)))
;; todo: check tramp-async-args and tramp-direct-async
(defun tramp-docker--add-method ()
"Add Tramp method handler for Docker containers."
(push `(,tramp-docker-method
(tramp-login-program ,tramp-docker-program)
(tramp-login-args (("exec")
("-it")
("-u" "%u")
("%h")
("/bin/sh")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c")))
tramp-methods))
(defun tramp-docker--remove-method ()
"Remove Tramp method handler for docker containers."
(setf (alist-get tramp-docker-method tramp-methods nil t 'string=) nil))
(defun tramp-docker-unload-function ()
"Remove Tramp method handler and completion functions."
(tramp-set-completion-function tramp-docker-method nil)
(tramp-docker--remove-method)
nil)
(when nil
(load-file (buffer-file-name))
(setq tramp-docker-program "doas podman")
(setq tramp-verbose 7) ;; default 3
(tramp-docker-setup)
(tramp-docker-unload-function))
;;;###autoload
(defun tramp-docker-setup ()
"Initialize Docker support for Tramp."
(tramp-docker--add-method)
(tramp-set-completion-function tramp-docker-method
'((tramp-docker--completion-function ""))))
(provide 'tramp-docker)
;;; tramp-docker.el ends here