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

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-06-24 09:20:14 +08:00
commit f5d142f663
11 changed files with 218 additions and 139 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
doc/lispref/modes.texi
View file

@ -2597,15 +2597,6 @@ It is normally @code{nil}, so that ordinary buffers have no header
line.
@end defvar
Emacs displays the header line for a window unless
@code{header-line-format} is either @code{nil}, or it's a list whose
@sc{car} is a symbol, and either that symbol is @code{:eval} and the
second list element evaluates to @code{nil} or the symbol's value as a
variable is @code{nil} or void. Note that there are other possible
values @code{header-line-format} that result in an empty header line
(for example, @code{""}), but all other values tell Emacs to display a
header line, whether or not it is empty.
If @code{display-line-numbers-mode} is turned on in a buffer
(@pxref{Display Custom, display-line-numbers-mode,, emacs, The GNU
Emacs Manual}), the buffer text is indented on display by the amount

11
doc/misc/tramp.texi
View file

@ -922,8 +922,15 @@ if desired.
@cindex @option{kubernetes} method
Integration for containers in Kubernetes pods. The host name is a pod
name returned by @samp{kubectl get pods}. The first container in a
pod is used.
name returned by @samp{kubectl get pods}, or
@samp{@var{container}.@var{pod}} if an explicit container name shall
be used. Otherwise, the first container in a pod is used.
@vindex tramp-kubernetes-context
@vindex tramp-kubernetes-namespace
If another Kubernetes context or namespace shall be used, configure
the user options @code{tramp-kubernetes-context} and
@code{tramp-kubernetes-namespace}.
This method does not support user names.

27
etc/NEWS
View file

@ -241,6 +241,14 @@ point is not in a comment or a string. It is by default bound to
They allow accessing system containers provided by Toolbox or
sandboxes provided by Flatpak.
+++
*** Connection method "kubernetes" supports now optional container name.
The host name for Kubernetes connections can be of kind [CONTAINER.]POD,
in order to specify a dedicated container. If there is just the pod
name, the first container in the pod is taken. The new user options
'tramp-kubernetes-context' and 'tramp-kubernetes-namespace' allow to
access pods with different context or namespace but the default one.
+++
*** Rename 'tramp-use-ssh-controlmaster-options' to 'tramp-use-connection-share'.
The old name still exists as obsolete variable alias. This user
@ -419,17 +427,18 @@ name as a string. The new function
completion based on dictionaries that the server supports.
** Pp
*** New 'pp-default-function' custom variable replaces 'pp-use-max-width'.
*** New 'pp-default-function' user option replaces 'pp-use-max-width'.
*** New default pretty printing function, which tries to obey 'fill-column'.
*** 'pp-to-string' takes an additional 'pp-function' argument.
This arg specifies the prettifying algorithm to use.
*** 'pp-to-string' takes an additional PP-FUNCTION argument.
This argument specifies the prettifying algorithm to use.
** Emacs Lisp mode
---
*** ',@' now has 'prefix' syntax
*** ',@' now has 'prefix' syntax.
Previously, the '@' character, which normally has 'symbol' syntax,
would combine with a following Lisp symbol and interfere with symbol
searching.
@ -493,17 +502,9 @@ hooks named after the feature name, like 'esh-mode-unload-hook'.
+++
** 'copy-tree' now copies records when its optional 2nd argument is non-nil.
+++
** Certain values of 'header-line-format' now inhibit empty header line.
Emacs now avoids displaying a header line, instead of displaying an
empty one, when 'header-line-format' is a list whose 'car' is a
symbol, and either that symbol is ':eval' and the second element of
the list evaluates to 'nil' or the symbol's value as a variable is
'nil' or void.
+++
** Regexp zero-width assertions followed by operators are better defined.
Previously, regexps such as "xy\\B*" would have ill-defined behaviour.
Previously, regexps such as "xy\\B*" would have ill-defined behavior.
Now any operator following a zero-width assertion applies to that
assertion only (which is useless). For historical compatibility, an
operator character following '^' or '\`' becomes literal, but we

33
lisp/emacs-lisp/cl-macs.el
View file

@ -243,6 +243,25 @@ The name is made by appending a number to PREFIX, default \"T\"."
(defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist!
(defvar cl--bind-lets) (defvar cl--bind-forms)
(defun cl--slet (bindings body)
"Like `cl--slet*' but for \"parallel let\"."
(cond
((seq-some (lambda (binding) (macroexp--dynamic-variable-p (car binding)))
bindings)
;; FIXME: We use `identity' to obfuscate the code enough to
;; circumvent the known bug in `macroexp--unfold-lambda' :-(
`(funcall (identity (lambda (,@(mapcar #'car bindings))
,@(macroexp-unprogn body)))
,@(mapcar #'cadr bindings)))
((null (cdr bindings))
(macroexp-let* bindings body))
(t `(let ,bindings ,@(macroexp-unprogn body)))))
(defun cl--slet* (bindings body)
"Like `macroexp-let*' but uses static scoping for all the BINDINGS."
(if (null bindings) body
(cl--slet `(,(car bindings)) (cl--slet* (cdr bindings) body))))
(defun cl--transform-lambda (form bind-block)
"Transform a function form FORM of name BIND-BLOCK.
BIND-BLOCK is the name of the symbol to which the function will be bound,
@ -337,10 +356,11 @@ FORM is of the form (ARGS . BODY)."
(list '&rest (car (pop cl--bind-lets))))))))
`((,@(nreverse simple-args) ,@rest-args)
,@header
,(macroexp-let* cl--bind-lets
(macroexp-progn
`(,@(nreverse cl--bind-forms)
,@body)))))))
;; Function arguments are unconditionally statically scoped (bug#47552).
,(cl--slet* cl--bind-lets
(macroexp-progn
`(,@(nreverse cl--bind-forms)
,@body)))))))
;;;###autoload
(defmacro cl-defun (name args &rest body)
@ -2896,9 +2916,10 @@ The function's arguments should be treated as immutable.
(cl-defun ,name ,args ,@body))))
(defun cl--defsubst-expand (argns body _simple whole _unsafe &rest argvs)
(if (and whole (not (cl--safe-expr-p (cons 'progn argvs))))
(if (and whole (not (cl--safe-expr-p (macroexp-progn argvs))))
whole
`(let ,(cl-mapcar #'list argns argvs) ,body)))
;; Function arguments are unconditionally statically scoped (bug#47552).
(cl--slet (cl-mapcar #'list argns argvs) body)))
;;; Structures.

145
lisp/net/tramp-container.el
View file

@ -37,19 +37,20 @@
;; C-x C-f /podman:USER@CONTAINER:/path/to/file
;;
;; Where:
;; USER is the user on the container to connect as (optional)
;; CONTAINER is the container to connect to
;; USER is the user on the container to connect as (optional).
;; CONTAINER is the container to connect to.
;;
;;
;;
;; Open file in a Kubernetes container:
;;
;; C-x C-f /kubernetes:POD:/path/to/file
;; C-x C-f /kubernetes:[CONTAINER.]POD:/path/to/file
;;
;; Where:
;; POD is the pod to connect to.
;; By default, the first container in that pod will be
;; used.
;; POD is the pod to connect to.
;; CONTAINER is the container to connect to (optional).
;; By default, the first container in that pod will
;; be used.
;;
;; Completion for POD and accessing it operate in the current
;; namespace, use this command to change it:
@ -63,7 +64,7 @@
;; C-x C-f /toolbox:CONTAINER:/path/to/file
;;
;; Where:
;; CONTAINER is the container to connect to (optional)
;; CONTAINER is the container to connect to (optional).
;;
;; If the container is not running, it is started. If no container is
;; specified, the default Toolbox container is used.
@ -106,6 +107,20 @@
:type '(choice (const "kubectl")
(string)))
(defcustom tramp-kubernetes-context nil
"Context of Kubernetes.
If it is nil, the default context will be used."
:group 'tramp
:version "30.1"
:type '(choice (const :tag "Use default" nil)
(string)))
(defcustom tramp-kubernetes-namespace "default"
"Namespace of Kubernetes."
:group 'tramp
:version "30.1"
:type 'string)
;;;###tramp-autoload
(defcustom tramp-toolbox-program "toolbox"
"Name of the Toolbox client program."
@ -172,29 +187,83 @@ This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(when-let ((default-directory tramp-compat-temporary-file-directory)
(raw-list (shell-command-to-string
(concat tramp-kubernetes-program
" get pods --no-headers "
"-o custom-columns=NAME:.metadata.name")))
(names (split-string raw-list "\n" 'omit)))
(mapcar (lambda (name) (list nil name)) (delq nil names))))
(concat
tramp-kubernetes-program " "
(tramp-kubernetes--context-namespace nil)
" get pods --no-headers"
;; We separate pods by "|". Inside a pod,
;; its name is separated from the containers
;; by ":". Containers are separated by ",".
" -o jsonpath='{range .items[*]}{\"|\"}{.metadata.name}"
"{\":\"}{range .spec.containers[*]}{.name}{\",\"}"
"{end}{end}'")))
(lines (split-string raw-list "|" 'omit)))
(let (names)
(dolist (line lines)
(setq line (split-string line ":" 'omit))
;; Pod name.
(push (car line) names)
;; Container names.
(dolist (elt (split-string (cadr line) "," 'omit))
(push (concat elt "." (car line)) names)))
(mapcar (lambda (name) (list nil name)) (delq nil names)))))
(defconst tramp-kubernetes--host-name-regexp
(rx (? (group (regexp tramp-host-regexp)) ".")
(group (regexp tramp-host-regexp)))
"The CONTAINER.POD syntax of kubernetes host names in Tramp.")
;;;###tramp-autoload
(defun tramp-kubernetes--container (vec)
"Extract the container name from a kubernetes host name in VEC."
(or (let ((host (tramp-file-name-host vec)))
(and (string-match tramp-kubernetes--host-name-regexp host)
(match-string 1 host)))
""))
;;;###tramp-autoload
(defun tramp-kubernetes--pod (vec)
"Extract the pod name from a kubernetes host name in VEC."
(or (let ((host (tramp-file-name-host vec)))
(and (string-match tramp-kubernetes--host-name-regexp host)
(match-string 2 host)))
""))
(defun tramp-kubernetes--current-context (vec)
"Return Kubernetes current context.
Obey `tramp-kubernetes-context'"
(or tramp-kubernetes-context
(with-tramp-connection-property nil "current-context"
(with-temp-buffer
(when (zerop
(tramp-call-process
vec tramp-kubernetes-program nil t nil
"config" "current-context"))
(goto-char (point-min))
(buffer-substring (point) (line-end-position)))))))
(defun tramp-kubernetes--current-context-data (vec)
"Return Kubernetes current context data as JSON string."
(with-temp-buffer
(when (zerop
(tramp-call-process
vec tramp-kubernetes-program nil t nil
"config" "current-context"))
(goto-char (point-min))
(let ((current-context (buffer-substring (point) (line-end-position))))
(erase-buffer)
(when (zerop
(tramp-call-process
vec tramp-kubernetes-program nil t nil
"config" "view" "-o"
(format
"jsonpath='{.contexts[?(@.name == \"%s\")]}'" current-context)))
(buffer-string))))))
(when-let ((current-context (tramp-kubernetes--current-context vec)))
(with-temp-buffer
(when (zerop
(tramp-call-process
vec tramp-kubernetes-program nil t nil
"config" "view" "-o"
(format
"jsonpath='{.contexts[?(@.name == \"%s\")]}'" current-context)))
(buffer-string)))))
;;;###tramp-autoload
(defun tramp-kubernetes--context-namespace (vec)
"The kubectl options for context and namespace."
(mapconcat
#'identity
`(,(when-let ((context (tramp-kubernetes--current-context vec)))
(format "--context=%s" context))
,(when tramp-kubernetes-namespace
(format "--namespace=%s" tramp-kubernetes-namespace)))
" "))
;;;###tramp-autoload
(defun tramp-toolbox--completion-function (&rest _args)
@ -275,12 +344,13 @@ see its function help for a description of the format."
(add-to-list 'tramp-methods
`(,tramp-kubernetes-method
(tramp-login-program ,tramp-kubernetes-program)
(tramp-login-args (("exec")
(tramp-login-args (("%x") ; context and namespace.
("exec")
("-c" "%a") ; container.
("%h")
("-it")
("--")
("%l")))
(tramp-config-check tramp-kubernetes--current-context-data)
(tramp-direct-async (,tramp-default-remote-shell "-c"))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@ -334,6 +404,23 @@ see its function help for a description of the format."
;; Default connection-local variables for Tramp.
(defconst tramp-container-connection-local-default-kubernetes-variables
'((tramp-config-check . tramp-kubernetes--current-context-data)
;; This variable will be eval'ed in `tramp-expand-args'.
(tramp-extra-expand-args
. (?a (tramp-kubernetes--container (car tramp-current-connection))
?h (tramp-kubernetes--pod (car tramp-current-connection))
?x (tramp-kubernetes--context-namespace (car tramp-current-connection)))))
"Default connection-local variables for remote kubernetes connections.")
(connection-local-set-profile-variables
'tramp-container-connection-local-default-kubernetes-profile
tramp-container-connection-local-default-kubernetes-variables)
(connection-local-set-profiles
`(:application tramp :protocol ,tramp-kubernetes-method)
'tramp-container-connection-local-default-kubernetes-profile)
(defconst tramp-container-connection-local-default-flatpak-variables
`((tramp-remote-path . ,(cons "/app/bin" tramp-remote-path)))
"Default connection-local variables for remote flatpak connections.")

10
lisp/net/tramp-sh.el
View file

@ -4324,6 +4324,14 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
(apply #'tramp-error-with-buffer
(tramp-get-connection-buffer vec) vec 'file-error error-args)))))
(defvar tramp-config-check nil
"A function to be called with one argument, VEC.
It should return a string which is used to check, whether the
configuration of the remote host has been changed (which would
require to flush the cache data). This string is kept as
connection property \"config-check-data\".
This variable is intended as connection-local variable.")
(defun tramp-open-connection-setup-interactive-shell (proc vec)
"Set up an interactive shell.
Mainly sets the prompt and the echo correctly. PROC is the shell
@ -4370,7 +4378,7 @@ process to set up. VEC specifies the connection."
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(config-check-function
(tramp-get-method-parameter vec 'tramp-config-check))
(buffer-local-value 'tramp-config-check (process-buffer proc)))
(old-config-check
(and config-check-function
(tramp-get-connection-property vec "config-check-data")))

29
lisp/net/tramp.el
View file

@ -305,13 +305,6 @@ pair of the form (KEY VALUE). The following KEYs are defined:
and container methods do. If it is a list of strings, they
are used to construct the remote command.
* `tramp-config-check'
A function to be called with one argument, VEC. It should
return a string which is used to check, whether the
configuration of the remote host has been changed (which
would require to flush the cache data). This string is kept
as connection property \"config-check-data\".
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
the file; this might be the absolute filename of scp or the name of
@ -4959,14 +4952,30 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
;; Result.
target-alist))
(defvar tramp-extra-expand-args nil
"Method specific arguments.")
(defun tramp-expand-args (vec parameter &rest spec-list)
"Expand login arguments as given by PARAMETER in `tramp-methods'.
PARAMETER is a symbol like `tramp-login-args', denoting a list of
list of strings from `tramp-methods', containing %-sequences for
substitution. SPEC-LIST is a list of char/value pairs used for
`format-spec-make'."
substitution.
SPEC-LIST is a list of char/value pairs used for
`format-spec-make'. It is appended by `tramp-extra-expand-args',
a connection-local variable."
(let ((args (tramp-get-method-parameter vec parameter))
(spec (apply 'format-spec-make spec-list)))
(extra-spec-list
(mapcar
#'eval
(buffer-local-value
'tramp-extra-expand-args (tramp-get-connection-buffer vec))))
spec)
;; Merge both spec lists. Remove duplicate entries.
(while spec-list
(unless (member (car spec-list) extra-spec-list)
(setq extra-spec-list (append (take 2 spec-list) extra-spec-list)))
(setq spec-list (cddr spec-list)))
(setq spec (apply #'format-spec-make extra-spec-list))
;; Expand format spec.
(flatten-tree
(mapcar

1
src/lisp.h
View file

@ -4179,7 +4179,6 @@ void set_frame_cursor_types (struct frame *, Lisp_Object);
extern void syms_of_xdisp (void);
extern void init_xdisp (void);
extern Lisp_Object safe_eval (Lisp_Object);
extern Lisp_Object safe_eval_inhibit_quit (Lisp_Object);
extern bool pos_visible_p (struct window *, ptrdiff_t, int *,
int *, int *, int *, int *, int *);

66
src/window.c
View file

@ -5472,58 +5472,6 @@ window_wants_mode_line (struct window *w)
&& WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w));
}
static int header_line_eval_called = 0;
/**
* null_header_line_format:
*
* Return non-zero when header line format FMT indicates that the
* header line should not be displayed at all, for windows on frame F.
*
* This is when FMT is nil, or if FMT is a cons cell and either its
* car is a symbol whose value as a variable is nil or void, or its
* car is the symbol ':eval' and its cadr evaluates to nil.
*/
static bool
null_header_line_format (Lisp_Object fmt, struct frame *f)
{
Lisp_Object car;
Lisp_Object val;
if (NILP (fmt))
return true;
if (CONSP (fmt))
{
car = XCAR (fmt);
if (SYMBOLP (car))
{
if (EQ (car, QCeval))
{
if (header_line_eval_called > 0)
return false;
eassert (header_line_eval_called == 0);
header_line_eval_called++;
val = safe_eval_inhibit_quit (XCAR (XCDR (fmt)));
header_line_eval_called--;
eassert (header_line_eval_called == 0);
if (!FRAME_LIVE_P (f))
{
header_line_eval_called = 0;
signal_error (":eval deleted the frame being displayed", fmt);
}
return NILP (val);
}
val = find_symbol_value (car);
return (SYMBOLP (car)
&& (EQ (val, Qunbound)
|| NILP (val)));
}
}
return false;
}
/**
* window_wants_header_line:
@ -5542,19 +5490,15 @@ null_header_line_format (Lisp_Object fmt, struct frame *f)
bool
window_wants_header_line (struct window *w)
{
Lisp_Object window_header_line_format
= window_parameter (w, Qheader_line_format);
Lisp_Object window_header_line_format =
window_parameter (w, Qheader_line_format);
struct frame *f = WINDOW_XFRAME (w);
Lisp_Object wbuffer = WINDOW_BUFFER (w);
return (BUFFERP (wbuffer)
return (WINDOW_LEAF_P (w)
&& !MINI_WINDOW_P (w)
&& !WINDOW_PSEUDO_P (w)
&& !EQ (window_header_line_format, Qnone)
&& (!null_header_line_format (window_header_line_format, f)
|| !null_header_line_format (BVAR (XBUFFER (wbuffer),
header_line_format), f))
&& (!NILP (window_header_line_format)
|| !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format)))
&& (WINDOW_PIXEL_HEIGHT (w)
> (window_wants_mode_line (w)
? 2 * WINDOW_FRAME_LINE_HEIGHT (w)

6
src/xdisp.c
View file

@ -3074,12 +3074,6 @@ safe__eval (bool inhibit_quit, Lisp_Object sexpr)
return safe__call1 (inhibit_quit, Qeval, sexpr);
}
Lisp_Object
safe_eval_inhibit_quit (Lisp_Object sexpr)
{
return safe__eval (true, sexpr);
}
/* Call function FN with two arguments ARG1 and ARG2.
Return the result, or nil if something went wrong. */

20
test/lisp/emacs-lisp/cl-macs-tests.el
View file

@ -803,10 +803,28 @@ See Bug#57915."
(macroexpand form)
(should (string-empty-p messages))))))))
(defvar cl--test-a)
(ert-deftest cl-&key-arguments ()
(cl-flet ((fn (&key x) x))
(should-error (fn :x))
(should (eq (fn :x :a) :a))))
(should (eq (fn :x :a) :a)))
;; In ELisp function arguments are always statically scoped (bug#47552).
(let ((cl--test-a 'dyn)
;; FIXME: How do we silence the "Lexical argument shadows" warning?
(f (cl-function (lambda (&key cl--test-a b)
(list cl--test-a (symbol-value 'cl--test-a) b)))))
(should (equal (funcall f :cl--test-a 'lex :b 2) '(lex dyn 2)))))
(cl-defstruct cl--test-s
cl--test-a b)
(ert-deftest cl-defstruct-dynbound-label-47552 ()
"Check that labels can have the same name as dynbound vars."
(let ((cl--test-a 'dyn))
(let ((x (make-cl--test-s :cl--test-a 4 :b cl--test-a)))
(should (cl--test-s-p x))
(should (equal (cl--test-s-cl--test-a x) 4))
(should (equal (cl--test-s-b x) 'dyn)))))
;;; cl-macs-tests.el ends here