diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 3bb3ae9b939..cdbda5503b7 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -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 diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index eb5c418728e..01f46865a39 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -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. diff --git a/etc/NEWS b/etc/NEWS index 487eaf22feb..c707ac279cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 0b09cd7d225..4caa573ea9d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -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. diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 473cb1c54b8..6e8d28a3016 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -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.") diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index da34f31fea6..d8231bd5bd2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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"))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2264ccd0707..7f818d81123 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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 diff --git a/src/lisp.h b/src/lisp.h index cb46487358e..e8cfda1be6e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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 *); diff --git a/src/window.c b/src/window.c index ea27fdda2a6..482db5dbed4 100644 --- a/src/window.c +++ b/src/window.c @@ -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) diff --git a/src/xdisp.c b/src/xdisp.c index 679f937a9c7..d928e9562d2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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. */ diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index a4bc8d542d4..01ca56386e3 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -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