diff options
Diffstat (limited to 'lisp')
33 files changed, 727 insertions, 361 deletions
diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el index 34154998cdf..499c9dce73a 100644 --- a/lisp/ansi-osc.el +++ b/lisp/ansi-osc.el @@ -125,13 +125,11 @@ and `shell-dirtrack-mode'." ;; Hyperlink handling (OSC 8) -(defvar ansi-osc-hyperlink-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\r" 'browse-url-button-open) - (define-key map [mouse-2] 'browse-url-button-open) - (define-key map [follow-link] 'mouse-face) - map) - "Keymap used by OSC 8 hyperlink buttons.") +(defvar-keymap ansi-osc-hyperlink-map + :doc "Keymap used by OSC 8 hyperlink buttons." + "C-c RET" #'browse-url-button-open + "<mouse-2>" #'browse-url-button-open + "<follow-link>" 'mouse-face) (define-button-type 'ansi-osc-hyperlink 'keymap ansi-osc-hyperlink-map diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 9db84c31b88..a33808ab92d 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -481,6 +481,11 @@ convention was modified." (puthash (indirect-function function) signature advertised-signature-table)) +(defun get-advertised-calling-convention (function) + "Get the advertised SIGNATURE of FUNCTION. +Return t if there isn't any." + (gethash function advertised-signature-table t)) + (defun make-obsolete (obsolete-name current-name when) "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete. OBSOLETE-NAME should be a function name or macro name (a symbol). diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ec45f488971..45ff1f4a8ec 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -129,6 +129,7 @@ ;; us from emitting warnings when compiling files which use cl-lib without ;; requiring it! (bug#30635) (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) ;; The feature of compiling in a specific target Emacs version ;; has been turned off because compile time options are a bad idea. @@ -1185,27 +1186,22 @@ message buffer `default-directory'." (defun byte-compile--first-symbol-with-pos (form) "Return the first symbol with position in form, or nil if none. Order is by depth-first search." - (cond - ((symbol-with-pos-p form) form) - ((consp form) - (or (byte-compile--first-symbol-with-pos (car form)) - (let ((sym nil)) - (setq form (cdr form)) - (while (and (consp form) - (not (setq sym (byte-compile--first-symbol-with-pos - (car form))))) - (setq form (cdr form))) - (or sym - (and form (byte-compile--first-symbol-with-pos form)))))) - ((or (vectorp form) (recordp form)) - (let ((len (length form)) - (i 0) - (sym nil)) - (while (and (< i len) - (not (setq sym (byte-compile--first-symbol-with-pos - (aref form i))))) - (setq i (1+ i))) - sym)))) + (named-let loop ((form form) + (depth 10)) ;Arbitrary limit. + (cond + ((<= depth 0) nil) ;Avoid cycles (bug#58601). + ((symbol-with-pos-p form) form) + ((consp form) + (or (loop (car form) (1- depth)) + (loop (cdr form) (1- depth)))) + ((or (vectorp form) (recordp form)) + (let ((len (length form)) + (i 0) + (sym nil)) + (while (and (< i len) + (not (setq sym (loop (aref form i) (1- depth))))) + (setq i (1+ i))) + sym))))) (defun byte-compile--warning-source-offset () "Return a source offset from `byte-compile-form-stack' or nil if none." @@ -1405,11 +1401,11 @@ when printing the error message." (and (not macro-p) (compiled-function-p (symbol-function fn))))) (setq fn (symbol-function fn))) - (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn)) - ;; Could be a subr. - (symbol-function fn) - fn) - advertised-signature-table t))) + (let ((advertised (get-advertised-calling-convention + (if (and (symbolp fn) (fboundp fn)) + ;; Could be a subr. + (symbol-function fn) + fn)))) (cond ((listp advertised) (if macro-p @@ -2335,9 +2331,15 @@ With argument ARG, insert value in current buffer after the form." (setq case-fold-search nil)) (displaying-byte-compile-warnings (with-current-buffer inbuffer - (and byte-compile-current-file - (byte-compile-insert-header byte-compile-current-file - byte-compile--outbuffer)) + (when byte-compile-current-file + (byte-compile-insert-header byte-compile-current-file + byte-compile--outbuffer) + ;; Instruct native-comp to ignore this file. + (when (bound-and-true-p no-native-compile) + (with-current-buffer byte-compile--outbuffer + (insert + "(when (boundp 'comp--no-native-compile) + (puthash load-file-name t comp--no-native-compile))\n\n")))) (goto-char (point-min)) ;; Should we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have been diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index b3ade3b8943..7b6d43e572b 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -650,13 +650,17 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (cl--generic-name generic) qualifiers specializers)) current-load-list :test #'equal) - (let (;; Prevent `defalias' from recording this as the definition site of + (let ((old-adv-cc (get-advertised-calling-convention + (symbol-function sym))) + ;; Prevent `defalias' from recording this as the definition site of ;; the generic function. current-load-list ;; BEWARE! Don't purify this function definition, since that leads ;; to memory corruption if the hash-tables it holds are modified ;; (the GC doesn't trace those pointers). (purify-flag nil)) + (when (listp old-adv-cc) + (set-advertised-calling-convention gfun old-adv-cc nil)) ;; But do use `defalias', so that it interacts properly with nadvice, ;; e.g. for tracing/debug-on-entry. (defalias sym gfun))))) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 889bffa3f5c..2c9b79334ba 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -687,6 +687,9 @@ Useful to hook into pass checkers.") 'native-compiler-error) +(defvar comp-no-spawn nil + "Non-nil don't spawn native compilation processes.") + ;; Moved early to avoid circularity when comp.el is loaded and ;; `macroexpand' needs to be advised (bug#47049). ;;;###autoload @@ -696,12 +699,9 @@ Useful to hook into pass checkers.") (memq subr-name native-comp-never-optimize-functions) (gethash subr-name comp-installed-trampolines-h)) (cl-assert (subr-primitive-p (symbol-function subr-name))) - (comp--install-trampoline - subr-name - (or (comp-trampoline-search subr-name) - (comp-trampoline-compile subr-name) - ;; Should never happen. - (cl-assert nil))))) + (when-let ((trampoline (or (comp-trampoline-search subr-name) + (comp-trampoline-compile subr-name)))) + (comp--install-trampoline subr-name trampoline)))) (cl-defstruct (comp-vec (:copier nil)) @@ -3689,7 +3689,8 @@ Prepare every function for final compilation and drive the C back-end." (print-circle t) (print-escape-multibyte t) (expr `((require 'comp) - (setf native-comp-verbose ,native-comp-verbose + (setf comp-no-spawn t + native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-ctxt ,comp-ctxt native-comp-eln-load-path ',native-comp-eln-load-path @@ -3945,8 +3946,9 @@ display a message." (file-newer-than-file-p source-file (comp-el-to-eln-filename source-file)))) do (let* ((expr `((require 'comp) - (setq comp-async-compilation t) - (setq warning-fill-column most-positive-fixnum) + (setq comp-async-compilation t + comp-no-spawn t + warning-fill-column most-positive-fixnum) ,(let ((set (list 'setq))) (dolist (var '(comp-file-preloaded-p native-compile-target-directory @@ -4046,72 +4048,73 @@ the deferred compilation mechanism." (stringp function-or-file)) (signal 'native-compiler-error (list "Not a function symbol or file" function-or-file))) - (catch 'no-native-compile - (let* ((print-symbols-bare t) - (data function-or-file) - (comp-native-compiling t) - (byte-native-qualities nil) - (symbols-with-pos-enabled t) - ;; Have byte compiler signal an error when compilation fails. - (byte-compile-debug t) - (comp-ctxt (make-comp-ctxt :output output - :with-late-load with-late-load))) - (comp-log "\n \n" 1) - (unwind-protect - (progn - (condition-case err - (cl-loop - with report = nil - for t0 = (current-time) - for pass in comp-passes - unless (memq pass comp-disabled-passes) - do - (comp-log (format "(%s) Running pass %s:\n" - function-or-file pass) - 2) - (setf data (funcall pass data)) - (push (cons pass (float-time (time-since t0))) report) - (cl-loop for f in (alist-get pass comp-post-pass-hooks) - do (funcall f data)) - finally - (when comp-log-time-report - (comp-log (format "Done compiling %s" data) 0) - (cl-loop for (pass . time) in (reverse report) - do (comp-log (format "Pass %s took: %fs." - pass time) 0)))) - (native-compiler-skip) - (t - (let ((err-val (cdr err))) - ;; If we are doing an async native compilation print the - ;; error in the correct format so is parsable and abort. - (if (and comp-async-compilation - (not (eq (car err) 'native-compiler-error))) - (progn - (message (if err-val - "%s: Error: %s %s" - "%s: Error %s") - function-or-file - (get (car err) 'error-message) - (car-safe err-val)) - (kill-emacs -1)) - ;; Otherwise re-signal it adding the compilation input. - (signal (car err) (if (consp err-val) - (cons function-or-file err-val) - (list function-or-file err-val))))))) - (if (stringp function-or-file) - data - ;; So we return the compiled function. - (native-elisp-load data))) - ;; We may have created a temporary file when we're being - ;; called with something other than a file as the argument. - ;; Delete it. - (when (and (not (stringp function-or-file)) - (not output) - comp-ctxt - (comp-ctxt-output comp-ctxt) - (file-exists-p (comp-ctxt-output comp-ctxt))) - (message "Deleting %s" (comp-ctxt-output comp-ctxt)) - (delete-file (comp-ctxt-output comp-ctxt))))))) + (unless comp-no-spawn + (catch 'no-native-compile + (let* ((print-symbols-bare t) + (data function-or-file) + (comp-native-compiling t) + (byte-native-qualities nil) + (symbols-with-pos-enabled t) + ;; Have byte compiler signal an error when compilation fails. + (byte-compile-debug t) + (comp-ctxt (make-comp-ctxt :output output + :with-late-load with-late-load))) + (comp-log "\n \n" 1) + (unwind-protect + (progn + (condition-case err + (cl-loop + with report = nil + for t0 = (current-time) + for pass in comp-passes + unless (memq pass comp-disabled-passes) + do + (comp-log (format "(%s) Running pass %s:\n" + function-or-file pass) + 2) + (setf data (funcall pass data)) + (push (cons pass (float-time (time-since t0))) report) + (cl-loop for f in (alist-get pass comp-post-pass-hooks) + do (funcall f data)) + finally + (when comp-log-time-report + (comp-log (format "Done compiling %s" data) 0) + (cl-loop for (pass . time) in (reverse report) + do (comp-log (format "Pass %s took: %fs." + pass time) 0)))) + (native-compiler-skip) + (t + (let ((err-val (cdr err))) + ;; If we are doing an async native compilation print the + ;; error in the correct format so is parsable and abort. + (if (and comp-async-compilation + (not (eq (car err) 'native-compiler-error))) + (progn + (message (if err-val + "%s: Error: %s %s" + "%s: Error %s") + function-or-file + (get (car err) 'error-message) + (car-safe err-val)) + (kill-emacs -1)) + ;; Otherwise re-signal it adding the compilation input. + (signal (car err) (if (consp err-val) + (cons function-or-file err-val) + (list function-or-file err-val))))))) + (if (stringp function-or-file) + data + ;; So we return the compiled function. + (native-elisp-load data))) + ;; We may have created a temporary file when we're being + ;; called with something other than a file as the argument. + ;; Delete it. + (when (and (not (stringp function-or-file)) + (not output) + comp-ctxt + (comp-ctxt-output comp-ctxt) + (file-exists-p (comp-ctxt-output comp-ctxt))) + (message "Deleting %s" (comp-ctxt-output comp-ctxt)) + (delete-file (comp-ctxt-output comp-ctxt)))))))) (defun native-compile-async-skip-p (file load selector) "Return non-nil if FILE's compilation should be skipped. @@ -4119,6 +4122,7 @@ the deferred compilation mechanism." LOAD and SELECTOR work as described in `native--compile-async'." ;; Make sure we are not already compiling `file' (bug#40838). (or (gethash file comp-async-compilations) + (gethash (file-name-with-extension file "elc") comp--no-native-compile) (cond ((null selector) nil) ((functionp selector) (not (funcall selector file))) @@ -4166,7 +4170,8 @@ bytecode definition was not changed in the meantime)." (error "LOAD must be nil, t or 'late")) (unless (listp files) (setf files (list files))) - (let (file-list) + (let ((added-something nil) + file-list) (dolist (file-or-dir files) (cond ((file-directory-p file-or-dir) (dolist (file (if recursively @@ -4194,11 +4199,15 @@ bytecode definition was not changed in the meantime)." (make-directory out-dir t)) (if (file-writable-p out-filename) (setf comp-files-queue - (append comp-files-queue `((,file . ,load)))) + (append comp-files-queue `((,file . ,load))) + added-something t) (display-warning 'comp (format "No write access for %s skipping." out-filename))))))) - (when (zerop (comp-async-runnings)) + ;; Perhaps nothing passed `native-compile-async-skip-p'? + (when (and added-something + ;; Don't start if there's one already running. + (zerop (comp-async-runnings))) (comp-run-async-workers)))) @@ -4234,14 +4243,13 @@ Search happens in `native-comp-eln-load-path'." (defun native-compile (function-or-file &optional output) "Compile FUNCTION-OR-FILE into native code. This is the synchronous entry-point for the Emacs Lisp native -compiler. -FUNCTION-OR-FILE is a function symbol, a form, or the filename of -an Emacs Lisp source file. -If OUTPUT is non-nil, use it as the filename for the compiled -object. -If FUNCTION-OR-FILE is a filename, return the filename of the -compiled object. If FUNCTION-OR-FILE is a function symbol or a -form, return the compiled function." +compiler. FUNCTION-OR-FILE is a function symbol, a form, or the +filename of an Emacs Lisp source file. If OUTPUT is non-nil, use +it as the filename for the compiled object. If FUNCTION-OR-FILE +is a filename, if the compilation was successful return the +filename of the compiled object. If FUNCTION-OR-FILE is a +function symbol or a form, if the compilation was successful +return the compiled function." (comp--native-compile function-or-file nil output)) ;;;###autoload @@ -4328,13 +4336,15 @@ of (commands) to run simultaneously." ;; `invocation-directory'. (setq dir (expand-file-name dir invocation-directory)) (when (file-exists-p dir) - (dolist (subdir (directory-files dir t)) + (dolist (subdir (seq-filter + (lambda (f) (not (string-match (rx "/." (? ".") eos) f))) + (directory-files dir t))) (when (and (file-directory-p subdir) (file-writable-p subdir) (not (equal (file-name-nondirectory (directory-file-name subdir)) comp-native-version-dir))) - (message "Deleting %s..." subdir) + (message "Deleting `%s'..." subdir) ;; We're being overly cautious here -- there shouldn't be ;; anything but .eln files in these directories. (dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'")) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index a1c4f91579e..ecc5f7e47bd 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -738,12 +738,12 @@ rules for built-in packages and excluded files." (expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory) output-file))) (let ((lisp-mode-autoload-regexp - "^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)")) + "^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)")) (loaddefs-generate (expand-file-name "../etc/themes/" lisp-directory) (expand-file-name "theme-loaddefs.el" lisp-directory)))) -;;;###autoload (load "theme-loaddefs.el") +;;;###autoload (load "theme-loaddefs.el" t) (provide 'loaddefs-gen) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 3f3a1616eee..4a41bbe8fa1 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -261,9 +261,9 @@ the command." (defcustom eshell-subcommand-bindings '((eshell-in-subcommand-p t) (eshell-in-pipeline-p nil) - (default-directory default-directory) - (process-environment (eshell-copy-environment))) + (default-directory default-directory)) "A list of `let' bindings for subcommand environments." + :version "29.1" ; removed `process-environment' :type 'sexp :risky t) @@ -1274,8 +1274,9 @@ be finished later after the completion of an asynchronous subprocess." name) (eshell-search-path name))))) (if (not program) - (eshell-error (format "which: no %s in (%s)\n" - name (getenv "PATH"))) + (eshell-error (format "which: no %s in (%s)\n" + name (string-join (eshell-get-path t) + (path-separator)))) (eshell-printn program))))) (put 'eshell/which 'eshell-no-numeric-conversions t) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 98902fc6f23..d513d750d9d 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -77,7 +77,7 @@ but Eshell will be able to understand (let ((list (eshell-get-path)) suffixes n1 n2 file) (while list - (setq n1 (concat (car list) name)) + (setq n1 (file-name-concat (car list) name)) (setq suffixes eshell-binary-suffixes) (while suffixes (setq n2 (concat n1 (car suffixes))) @@ -239,17 +239,16 @@ causing the user to wonder if anything's really going on..." (?h "help" nil nil "display this usage message") :usage "[-b] PATH Adds the given PATH to $PATH.") - (if args - (progn - (setq eshell-path-env (getenv "PATH") - args (mapconcat #'identity args path-separator) - eshell-path-env - (if prepend - (concat args path-separator eshell-path-env) - (concat eshell-path-env path-separator args))) - (setenv "PATH" eshell-path-env)) - (dolist (dir (parse-colon-path (getenv "PATH"))) - (eshell-printn dir))))) + (let ((path (eshell-get-path t))) + (if args + (progn + (setq path (if prepend + (append args path) + (append path args))) + (eshell-set-path path) + (string-join path (path-separator))) + (dolist (dir path) + (eshell-printn dir)))))) (put 'eshell/addpath 'eshell-no-numeric-conversions t) (put 'eshell/addpath 'eshell-filename-arguments t) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 9258ca5e40e..9b464a0a137 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -249,17 +249,60 @@ trailing newlines removed. Otherwise, this behaves as follows: It might be different from \(getenv \"PATH\"), when `default-directory' points to a remote host.") -(defun eshell-get-path () +(make-obsolete-variable 'eshell-path-env 'eshell-get-path "29.1") + +(defvar-local eshell-path-env-list nil) + +(connection-local-set-profile-variables + 'eshell-connection-default-profile + '((eshell-path-env-list . nil))) + +(connection-local-set-profiles + '(:application eshell) + 'eshell-connection-default-profile) + +(defun eshell-get-path (&optional literal-p) "Return $PATH as a list. -Add the current directory on MS-Windows." - (eshell-parse-colon-path - (if (eshell-under-windows-p) - (concat "." path-separator eshell-path-env) - eshell-path-env))) +If LITERAL-P is nil, return each directory of the path as a full, +possibly-remote file name; on MS-Windows, add the current +directory as the first directory in the path as well. + +If LITERAL-P is non-nil, return the local part of each directory, +as the $PATH was actually specified." + (with-connection-local-application-variables 'eshell + (let ((remote (file-remote-p default-directory)) + (path + (or eshell-path-env-list + ;; If not already cached, get the path from + ;; `exec-path', removing the last element, which is + ;; `exec-directory'. + (setq-connection-local eshell-path-env-list + (butlast (exec-path)))))) + (when (and (not literal-p) + (not remote) + (eshell-under-windows-p)) + (push "." path)) + (if (and remote (not literal-p)) + (mapcar (lambda (x) (file-name-concat remote x)) path) + path)))) + +(defun eshell-set-path (path) + "Set the Eshell $PATH to PATH. +PATH can be either a list of directories or a string of +directories separated by `path-separator'." + (with-connection-local-application-variables 'eshell + (setq-connection-local + eshell-path-env-list + (if (listp path) + path + ;; Don't use `parse-colon-path' here, since we don't want + ;; the additonal translations it does on each element. + (split-string path (path-separator)))))) (defun eshell-parse-colon-path (path-env) "Split string with `parse-colon-path'. Prepend remote identification of `default-directory', if any." + (declare (obsolete nil "29.1")) (let ((remote (file-remote-p default-directory))) (if remote (mapcar diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 36e59cd5a41..57ea42f4933 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -113,7 +113,7 @@ (require 'pcomplete) (require 'ring) -(defconst eshell-inside-emacs (format "%s,eshell" emacs-version) +(defvar-local eshell-inside-emacs (format "%s,eshell" emacs-version) "Value for the `INSIDE_EMACS' environment variable.") (defgroup eshell-var nil @@ -156,14 +156,21 @@ if they are quoted with a backslash." ("LINES" ,(lambda () (window-body-height nil 'remap)) t t) ("INSIDE_EMACS" eshell-inside-emacs t) - ;; for eshell-cmd.el + ;; for esh-ext.el + ("PATH" (,(lambda () (string-join (eshell-get-path t) (path-separator))) + . ,(lambda (_ value) + (eshell-set-path value) + value)) + t t) + + ;; for esh-cmd.el ("_" ,(lambda (indices quoted) (if (not indices) (car (last eshell-last-arguments)) (eshell-apply-indices eshell-last-arguments indices quoted)))) - ("?" eshell-last-command-status) - ("$" eshell-last-command-result) + ("?" (eshell-last-command-status . nil)) + ("$" (eshell-last-command-result . nil)) ;; for em-alias.el and em-script.el ("0" eshell-command-name) @@ -176,7 +183,7 @@ if they are quoted with a backslash." ("7" ,(lambda () (nth 6 eshell-command-arguments)) nil t) ("8" ,(lambda () (nth 7 eshell-command-arguments)) nil t) ("9" ,(lambda () (nth 8 eshell-command-arguments)) nil t) - ("*" eshell-command-arguments)) + ("*" (eshell-command-arguments . nil))) "This list provides aliasing for variable references. Each member is of the following form: @@ -186,6 +193,11 @@ NAME defines the name of the variable, VALUE is a Lisp value used to compute the string value that will be returned when the variable is accessed via the syntax `$NAME'. +If VALUE is a cons (GET . SET), then variable references to NAME +will use GET to get the value, and SET to set it. GET and SET +can be one of the forms described below. If SET is nil, the +variable is read-only. + If VALUE is a function, its behavior depends on the value of SIMPLE-FUNCTION. If SIMPLE-FUNCTION is nil, call VALUE with two arguments: the list of the indices that were used in the reference, @@ -193,23 +205,30 @@ and either t or nil depending on whether or not the variable was quoted with double quotes. For example, if `NAME' were aliased to a function, a reference of `$NAME[10][20]' would result in that function being called with the arguments `((\"10\") (\"20\"))' and -nil. -If SIMPLE-FUNCTION is non-nil, call the function with no arguments -and then pass its return value to `eshell-apply-indices'. +nil. If SIMPLE-FUNCTION is non-nil, call the function with no +arguments and then pass its return value to `eshell-apply-indices'. + +When VALUE is a function, it's read-only by default. To make it +writeable, use the (GET . SET) form described above. If SET is a +function, it takes two arguments: a list of indices (currently +always nil, but reserved for future enhancement), and the new +value to set. -If VALUE is a string, return the value for the variable with that -name in the current environment. If no variable with that name exists -in the environment, but if a symbol with that same name exists and has -a value bound to it, return that symbol's value instead. You can -prefer symbol values over environment values by setting the value -of `eshell-prefer-lisp-variables' to t. +If VALUE is a string, get/set the value for the variable with +that name in the current environment. When getting the value, if +no variable with that name exists in the environment, but if a +symbol with that same name exists and has a value bound to it, +return that symbol's value instead. You can prefer symbol values +over environment values by setting the value of +`eshell-prefer-lisp-variables' to t. -If VALUE is a symbol, return the value bound to it. +If VALUE is a symbol, get/set the value bound to it. If VALUE has any other type, signal an error. Additionally, if COPY-TO-ENVIRONMENT is non-nil, the alias should be copied (a.k.a. \"exported\") to the environment of created subprocesses." + :version "29.1" :type '(repeat (list string sexp (choice (const :tag "Copy to environment" t) (const :tag "Use only in Eshell" nil)) @@ -234,6 +253,12 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." ;; changing a variable will affect all of Emacs. (unless eshell-modify-global-environment (setq-local process-environment (eshell-copy-environment))) + (setq-local eshell-subcommand-bindings + (append + '((process-environment (eshell-copy-environment)) + (eshell-variable-aliases-list eshell-variable-aliases-list) + (eshell-path-env-list eshell-path-env-list)) + eshell-subcommand-bindings)) (setq-local eshell-special-chars-inside-quoting (append eshell-special-chars-inside-quoting '(?$))) @@ -282,9 +307,9 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (while (string-match setvar command) (nconc l (list - (list 'setenv (match-string 1 command) - (match-string 2 command) - (= (length (match-string 2 command)) 0)))) + (list 'eshell-set-variable + (match-string 1 command) + (match-string 2 command)))) (setq command (eshell-stringify (car args)) args (cdr args))) (cdr l)) @@ -302,6 +327,11 @@ This function is explicit for adding to `eshell-parse-argument-hook'." (defun eshell/define (var-alias definition) "Define a VAR-ALIAS using DEFINITION." + ;; FIXME: This function doesn't work (it produces variable aliases + ;; in a form not recognized by other parts of the code), and likely + ;; hasn't worked since before its introduction into Emacs. It + ;; should either be removed or fixed up. + (declare (obsolete nil "29.1")) (if (not definition) (setq eshell-variable-aliases-list (delq (assoc var-alias eshell-variable-aliases-list) @@ -323,12 +353,11 @@ This function is explicit for adding to `eshell-parse-argument-hook'." (defun eshell/export (&rest sets) "This alias allows the `export' command to act as bash users expect." - (while sets - (if (and (stringp (car sets)) - (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets))) - (setenv (match-string 1 (car sets)) - (match-string 2 (car sets)))) - (setq sets (cdr sets)))) + (dolist (set sets) + (when (and (stringp set) + (string-match "^\\([^=]+\\)=\\(.*\\)" set)) + (eshell-set-variable (match-string 1 set) + (match-string 2 set))))) (defun pcomplete/eshell-mode/export () "Completion function for Eshell's `export'." @@ -338,16 +367,28 @@ This function is explicit for adding to `eshell-parse-argument-hook'." (eshell-envvar-names))))) (defun eshell/unset (&rest args) - "Unset an environment variable." - (while args - (if (stringp (car args)) - (setenv (car args) nil t)) - (setq args (cdr args)))) + "Unset one or more variables. +This is equivalent to calling `eshell/set' for all of ARGS with +the values of nil for each." + (dolist (arg args) + (eshell-set-variable arg nil))) (defun pcomplete/eshell-mode/unset () "Completion function for Eshell's `unset'." (while (pcomplete-here (eshell-envvar-names)))) +(defun eshell/set (&rest args) + "Allow command-ish use of `set'." + (let (last-value) + (while args + (setq last-value (eshell-set-variable (car args) (cadr args)) + args (cddr args))) + last-value)) + +(defun pcomplete/eshell-mode/set () + "Completion function for Eshell's `set'." + (while (pcomplete-here (eshell-envvar-names)))) + (defun eshell/setq (&rest args) "Allow command-ish use of `setq'." (let (last-value) @@ -561,18 +602,21 @@ INDICES is a list of index-lists (see `eshell-parse-indices'). If QUOTED is non-nil, this was invoked inside double-quotes." (if-let ((alias (assoc name eshell-variable-aliases-list))) (let ((target (nth 1 alias))) + (when (and (not (functionp target)) + (consp target)) + (setq target (car target))) (cond ((functionp target) (if (nth 3 alias) (eshell-apply-indices (funcall target) indices quoted) - (condition-case nil - (funcall target indices quoted) - (wrong-number-of-arguments - (display-warning - :warning (concat "Function for `eshell-variable-aliases-list' " - "entry should accept two arguments: INDICES " - "and QUOTED.'")) - (funcall target indices))))) + (let ((max-arity (cdr (func-arity target)))) + (if (or (eq max-arity 'many) (>= max-arity 2)) + (funcall target indices quoted) + (display-warning + :warning (concat "Function for `eshell-variable-aliases-list' " + "entry should accept two arguments: INDICES " + "and QUOTED.'")) + (funcall target indices))))) ((symbolp target) (eshell-apply-indices (symbol-value target) indices quoted)) (t @@ -589,6 +633,44 @@ If QUOTED is non-nil, this was invoked inside double-quotes." (getenv name))) indices quoted))) +(defun eshell-set-variable (name value) + "Set the variable named NAME to VALUE. +NAME can be a string (in which case it refers to an environment +variable or variable alias) or a symbol (in which case it refers +to a Lisp variable)." + (if-let ((alias (assoc name eshell-variable-aliases-list))) + (let ((target (nth 1 alias))) + (cond + ((functionp target) + (setq target nil)) + ((consp target) + (setq target (cdr target)))) + (cond + ((functionp target) + (funcall target nil value)) + ((null target) + (unless eshell-in-subcommand-p + (error "Variable `%s' is not settable" (eshell-stringify name))) + (push `(,name ,(lambda () value) t t) + eshell-variable-aliases-list) + value) + ;; Since getting a variable alias with a string target and + ;; `eshell-prefer-lisp-variables' non-nil gets the + ;; corresponding Lisp variable, make sure setting does the + ;; same. + ((and eshell-prefer-lisp-variables + (stringp target)) + (eshell-set-variable (intern target) value)) + (t + (eshell-set-variable target value)))) + (cond + ((stringp name) + (setenv name value)) + ((symbolp name) + (set name value)) + (t + (error "Unknown variable `%s'" (eshell-stringify name)))))) + (defun eshell-apply-indices (value indices &optional quoted) "Apply to VALUE all of the given INDICES, returning the sub-result. The format of INDICES is: diff --git a/lisp/files-x.el b/lisp/files-x.el index 0131d495f27..3516592fc3e 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -620,6 +620,18 @@ PROFILES is a list of connection profiles (symbols)." :group 'tramp :version "29.1") +(defvar connection-local-criteria nil + "The current connection-local criteria, or nil. +This is set while executing the body of +`with-connection-local-variables'.") + +(defvar connection-local-profile-name-for-setq nil + "The current connection-local profile name, or nil. +This is the name of the profile to use when setting variables via +`setq-connection-local'. Its value is derived from +`connection-local-criteria' and is set while executing the body +of `with-connection-local-variables'.") + (defsubst connection-local-normalize-criteria (criteria) "Normalize plist CRITERIA according to properties. Return a reordered plist." @@ -696,6 +708,23 @@ in order." (customize-set-variable 'connection-local-profile-alist connection-local-profile-alist)) +;;;###autoload +(defun connection-local-update-profile-variables (profile variables) + "Update the variable settings for PROFILE in-place. +VARIABLES is a list that declares connection-local variables for +the connection profile. An element in VARIABLES is an alist +whose elements are of the form (VAR . VALUE). + +Unlike `connection-local-set-profile-variables' (which see), this +function preserves the values of any existing variable +definitions that aren't listed in VARIABLES." + (when-let ((existing-variables + (nreverse (connection-local-get-profile-variables profile)))) + (dolist (var variables) + (setf (alist-get (car var) existing-variables) (cdr var))) + (setq variables (nreverse existing-variables))) + (connection-local-set-profile-variables profile variables)) + (defun hack-connection-local-variables (criteria) "Read connection-local variables according to CRITERIA. Store the connection-local variables in buffer local @@ -738,6 +767,15 @@ If APPLICATION is nil, `connection-local-default-application' is used." :user ,(file-remote-p default-directory 'user) :machine ,(file-remote-p default-directory 'host)))) +(defun connection-local-profile-name-for-criteria (criteria) + "Get a connection-local profile name based on CRITERIA." + (when criteria + (let (print-level print-length) + (intern (concat + "autogenerated-connection-local-profile/" + (prin1-to-string + (connection-local-normalize-criteria criteria))))))) + ;;;###autoload (defmacro with-connection-local-variables (&rest body) "Apply connection-local variables according to `default-directory'. @@ -746,15 +784,27 @@ Execute BODY, and unwind connection-local variables." `(with-connection-local-variables-1 (lambda () ,@body))) ;;;###autoload +(defmacro with-connection-local-application-variables (application &rest body) + "Apply connection-local variables for APPLICATION in `default-directory'. +Execute BODY, and unwind connection-local variables." + (declare (debug t) (indent 1)) + `(let ((connection-local-default-application ,application)) + (with-connection-local-variables-1 (lambda () ,@body)))) + +;;;###autoload (defun with-connection-local-variables-1 (body-fun) "Apply connection-local variables according to `default-directory'. Call BODY-FUN with no args, and then unwind connection-local variables." (if (file-remote-p default-directory) - (let ((enable-connection-local-variables t) - (old-buffer-local-variables (buffer-local-variables)) - connection-local-variables-alist) - (hack-connection-local-variables-apply - (connection-local-criteria-for-default-directory)) + (let* ((enable-connection-local-variables t) + (connection-local-criteria + (connection-local-criteria-for-default-directory)) + (connection-local-profile-name-for-setq + (connection-local-profile-name-for-criteria + connection-local-criteria)) + (old-buffer-local-variables (buffer-local-variables)) + connection-local-variables-alist) + (hack-connection-local-variables-apply connection-local-criteria) (unwind-protect (funcall body-fun) ;; Cleanup. @@ -767,6 +817,49 @@ Call BODY-FUN with no args, and then unwind connection-local variables." (funcall body-fun))) ;;;###autoload +(defmacro setq-connection-local (&rest pairs) + "Set each VARIABLE connection-locally to VALUE. + +When `connection-local-profile-name-for-setq' is set, assign each +variable's value on that connection profile, and set that profile +for `connection-local-criteria'. You can use this in combination +with `with-connection-local-variables', as in + + (with-connection-local-variables + (setq-connection-local VARIABLE VALUE)) + +If there's no connection-local profile to use, just set the +variables normally, as with `setq'. + +The variables are literal symbols and should not be quoted. The +second VALUE is not computed until after the first VARIABLE is +set, and so on; each VALUE can use the new value of variables set +earlier in the `setq-connection-local'. The return value of the +`setq-connection-local' form is the value of the last VALUE. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + (let ((set-expr nil) + (profile-vars nil)) + (while pairs + (unless (symbolp (car pairs)) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(set ',(car pairs) ,(cadr pairs)) set-expr) + (push `(cons ',(car pairs) ,(car pairs)) profile-vars) + (setq pairs (cddr pairs))) + `(prog1 + ,(macroexp-progn (nreverse set-expr)) + (when connection-local-profile-name-for-setq + (connection-local-update-profile-variables + connection-local-profile-name-for-setq + (list ,@(nreverse profile-vars))) + (connection-local-set-profiles + connection-local-criteria + connection-local-profile-name-for-setq))))) + +;;;###autoload (defun path-separator () "The connection-local value of `path-separator'." (with-connection-local-variables path-separator)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5e4e9854a6b..a714e318767 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5192,10 +5192,7 @@ command evaluates `message-send-mail-hook' just before sending a message." (defun message-canlock-generate () "Return a string that is non-trivial to guess. Do not use this for anything important, it is cryptographically weak." - (sha1 (concat (message-unique-id) - (format "%x%x%x" (random) (random) (random)) - (prin1-to-string (recent-keys)) - (prin1-to-string (garbage-collect))))) + (secure-hash 'sha1 'iv-auto 128)) (defvar canlock-password) (defvar canlock-password-for-verify) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index eef895ae88b..e29f763dabc 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -669,7 +669,7 @@ the C sources, too." "Insert usage at point and return docstring. With highlighting." (if (keymapp function) doc ; If definition is a keymap, skip arglist note. - (let* ((advertised (gethash real-def advertised-signature-table t)) + (let* ((advertised (get-advertised-calling-convention real-def)) (arglist (if (listp advertised) advertised (help-function-arglist real-def))) (usage (help-split-fundoc doc function))) diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 91c2a804000..cf024afe254 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -147,16 +147,16 @@ and then returns." (while (or (memq char (append help-event-list (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s deletechar backspace vertical-scroll-bar - next prior up down)))) + home end next prior up down)))) (eq (car-safe char) 'switch-frame) (equal key "\M-v")) (condition-case nil (cond ((eq (car-safe char) 'switch-frame) (handle-switch-frame char)) - ((memq char '(?\C-v ?\s next)) + ((memq char '(?\C-v ?\s next end)) (scroll-up)) - ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior)) + ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior home)) (equal key "\M-v")) (scroll-down)) ((memq char '(down)) @@ -210,7 +210,11 @@ and then returns." (unless (eq new-frame (selected-frame)) (iconify-frame new-frame)) (setq new-frame nil))) - (ding))))) + (unless (equal (key-description key) "C-g") + (message (substitute-command-keys + (format "No help command is bound to `\\`%s''" + (key-description key)))) + (ding)))))) (when config (set-window-configuration config)) (when new-frame diff --git a/lisp/help.el b/lisp/help.el index 3f5e57d7d5f..0f5342b77d3 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -259,7 +259,10 @@ buffer.") ;; help command loop. (help-quit)) ((and-let* ((window (get-buffer-window "*Quick Help*"))) - (quit-window t window))) + (quit-window t window) + ;; Clear the message we may have gotten from `C-h' and then + ;; waiting before hitting `q'. + (message ""))) ((help-quick)))) (defvar help-return-method nil @@ -741,7 +744,8 @@ or a buffer name." (setq-local outline-heading-end-regexp ":\n") (setq-local outline-level (lambda () 1)) (setq-local outline-minor-mode-cycle t - outline-minor-mode-highlight t) + outline-minor-mode-highlight t + outline-minor-mode-insert-buttons t) (outline-minor-mode 1) (save-excursion (goto-char (point-min)) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 517b23b1ea9..b992846b0b6 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4702,14 +4702,13 @@ Search happens in `native-comp-eln-load-path'. (autoload 'native-compile "comp" "\ Compile FUNCTION-OR-FILE into native code. This is the synchronous entry-point for the Emacs Lisp native -compiler. -FUNCTION-OR-FILE is a function symbol, a form, or the filename of -an Emacs Lisp source file. -If OUTPUT is non-nil, use it as the filename for the compiled -object. -If FUNCTION-OR-FILE is a filename, return the filename of the -compiled object. If FUNCTION-OR-FILE is a function symbol or a -form, return the compiled function. +compiler. FUNCTION-OR-FILE is a function symbol, a form, or the +filename of an Emacs Lisp source file. If OUTPUT is non-nil, use +it as the filename for the compiled object. If FUNCTION-OR-FILE +is a filename, if the compilation was successful return the +filename of the compiled object. If FUNCTION-OR-FILE is a +function symbol or a form, if the compilation was successful +return the compiled function. (fn FUNCTION-OR-FILE &optional OUTPUT)") (autoload 'batch-native-compile "comp" "\ @@ -4960,8 +4959,6 @@ evaluate `compilation-shell-minor-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. -\\{compilation-shell-minor-mode-map} - (fn &optional ARG)" t) (autoload 'compilation-minor-mode "compile" "\ Toggle Compilation minor mode. @@ -4985,8 +4982,6 @@ evaluate `compilation-minor-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. -\\{compilation-minor-mode-map} - (fn &optional ARG)" t) (autoload 'compilation-next-error-function "compile" "\ Advance to the next error message and visit the file where the error was. @@ -8371,7 +8366,7 @@ A second call of this function without changing point inserts the next match. A call with prefix PREFIX reads the symbol to insert from the minibuffer with completion. -(fn PREFIX)" t) +(fn PREFIX)" '("P")) (autoload 'ebrowse-tags-loop-continue "ebrowse" "\ Repeat last operation on files in tree. FIRST-TIME non-nil means this is not a repetition, but the first time. @@ -9920,7 +9915,7 @@ When present, ID should be an opaque object used to identify the connection unequivocally. This is rarely needed and not available interactively. -(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME (erc-compute-full-name)) ID)" t) +(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME (erc-compute-full-name)) ID)" '((erc-select-read-args))) (defalias 'erc-select #'erc) (autoload 'erc-tls "erc" "\ ERC is a powerful, modular, and extensible IRC client. @@ -9967,7 +9962,7 @@ symbol composed of letters from the Latin alphabet.) This option is generally unneeded, however. See info node `(erc) Connecting' for use cases. Not available interactively. -(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE ID)" t) +(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) (USER (erc-compute-user)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE ID)" '((let ((erc-default-port erc-default-port-tls)) (erc-select-read-args)))) (autoload 'erc-handle-irc-url "erc" "\ Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD. If ERC is already connected to HOST:PORT, simply /join CHANNEL. @@ -10183,9 +10178,7 @@ it has to be wrapped in `(eval (quote ...))'. If NAME is already defined as a test and Emacs is running in batch mode, an error is signalled. -(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] BODY...)" nil t) -(function-put 'ert-deftest 'doc-string-elt 3) -(function-put 'ert-deftest 'lisp-indent-function 2) +(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags \\='(TAG...)] BODY...)" nil 'macro) (autoload 'ert-run-tests-batch "ert" "\ Run the tests specified by SELECTOR, printing results to the terminal. @@ -11720,6 +11713,17 @@ VARIABLES list of the connection profile. The list is processed in order. (fn PROFILE VARIABLES)") +(autoload 'connection-local-update-profile-variables "files-x" "\ +Update the variable settings for PROFILE in-place. +VARIABLES is a list that declares connection-local variables for +the connection profile. An element in VARIABLES is an alist +whose elements are of the form (VAR . VALUE). + +Unlike `connection-local-set-profile-variables' (which see), this +function preserves the values of any existing variable +definitions that aren't listed in VARIABLES. + +(fn PROFILE VARIABLES)") (autoload 'hack-connection-local-variables-apply "files-x" "\ Apply connection-local variables identified by CRITERIA. Other local variables, like file-local and dir-local variables, @@ -11731,11 +11735,38 @@ Apply connection-local variables according to `default-directory'. Execute BODY, and unwind connection-local variables. (fn &rest BODY)" nil t) +(autoload 'with-connection-local-application-variables "files-x" "\ +Apply connection-local variables for APPLICATION in `default-directory'. +Execute BODY, and unwind connection-local variables. + +(fn APPLICATION &rest BODY)" nil t) +(function-put 'with-connection-local-application-variables 'lisp-indent-function 1) (autoload 'with-connection-local-variables-1 "files-x" "\ Apply connection-local variables according to `default-directory'. Call BODY-FUN with no args, and then unwind connection-local variables. (fn BODY-FUN)") +(autoload 'setq-connection-local "files-x" "\ +Set each VARIABLE connection-locally to VALUE. + +When `connection-local-profile-name-for-setq' is set, assign each +variable's value on that connection profile, and set that profile +for `connection-local-criteria'. You can use this in combination +with `with-connection-local-variables', as in + + (with-connection-local-variables + (setq-connection-local VARIABLE VALUE)) + +If there's no connection-local profile to use, just set the +variables normally, as with `setq'. + +The variables are literal symbols and should not be quoted. The +second VALUE is not computed until after the first VARIABLE is +set, and so on; each VALUE can use the new value of variables set +earlier in the `setq-connection-local'. The return value of the +`setq-connection-local' form is the value of the last VALUE. + +(fn [VARIABLE VALUE]...)" nil t) (autoload 'path-separator "files-x" "\ The connection-local value of `path-separator'.") (autoload 'null-device "files-x" "\ @@ -12261,8 +12292,6 @@ evaluate `flymake-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. -\\{flymake-mode-map} - (fn &optional ARG)" t) (autoload 'flymake-mode-on "flymake" "\ Turn Flymake mode on.") @@ -15888,8 +15917,7 @@ inlined into the compiled format versions. This means that if you change its definition, you should explicitly call `ibuffer-recompile-formats'. -(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t) -(function-put 'define-ibuffer-column 'lisp-indent-function 'defun) +(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil 'macro) (autoload 'define-ibuffer-sorter "ibuf-macs" "\ Define a method of sorting named NAME. DOCUMENTATION is the documentation of the function, which will be called @@ -15900,9 +15928,7 @@ For sorting, the forms in BODY will be evaluated with `a' bound to one buffer object, and `b' bound to another. BODY should return a non-nil value if and only if `a' is \"less than\" `b'. -(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t) -(function-put 'define-ibuffer-sorter 'lisp-indent-function 1) -(function-put 'define-ibuffer-sorter 'doc-string-elt 2) +(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil 'macro) (autoload 'define-ibuffer-op "ibuf-macs" "\ Generate a function which operates on a buffer. OP becomes the name of the function; if it doesn't begin with @@ -15941,9 +15967,7 @@ BODY define the operation; they are forms to evaluate per each marked buffer. BODY is evaluated with `buf' bound to the buffer object. -(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil t) -(function-put 'define-ibuffer-op 'lisp-indent-function 2) -(function-put 'define-ibuffer-op 'doc-string-elt 3) +(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING BEFORE AFTER COMPLEX) &rest BODY)" nil 'macro) (autoload 'define-ibuffer-filter "ibuf-macs" "\ Define a filter named NAME. DOCUMENTATION is the documentation of the function. @@ -15958,9 +15982,7 @@ not a particular buffer should be displayed or not. The forms in BODY will be evaluated with BUF bound to the buffer object, and QUALIFIER bound to the current value of the filter. -(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t) -(function-put 'define-ibuffer-filter 'lisp-indent-function 2) -(function-put 'define-ibuffer-filter 'doc-string-elt 2) +(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil 'macro) (register-definition-prefixes "ibuf-macs" '("ibuffer-")) @@ -18726,6 +18748,7 @@ This scans for ;;;###autoload forms and related things. The first element on the command line should be the (main) loaddefs.el output file, and the rest are the directories to use.") + (load "theme-loaddefs.el" t) (register-definition-prefixes "loaddefs-gen" '("autoload-" "generated-autoload-" "loaddefs-generate--" "no-update-autoloads")) @@ -25598,8 +25621,6 @@ evaluate `rectangle-mark-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. -\\{rectangle-mark-mode-map} - (fn &optional ARG)" t) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")) diff --git a/lisp/loadup.el b/lisp/loadup.el index c01c827a75e..e940a32100c 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -501,7 +501,10 @@ lost after dumping"))) bin-dest-dir) ;; Relative filename from the built uninstalled binary. (file-relative-name file invocation-directory))))) - comp-loaded-comp-units-h)))) + comp-loaded-comp-units-h))) + ;; Set up the mechanism to allow inhibiting native-comp via + ;; file-local variables. + (defvar comp--no-native-compile (make-hash-table :test #'equal))) (when (hash-table-p purify-flag) (let ((strings 0) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index c2c18320b15..526bccbbac9 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -527,12 +527,12 @@ `(menu-item "Paste" yank :enable (funcall ',(lambda () - (and (or + (and (not buffer-read-only) + (or (gui-backend-selection-exists-p 'CLIPBOARD) (if (featurep 'ns) ; like paste-from-menu (cdr yank-menu) - kill-ring)) - (not buffer-read-only)))) + kill-ring))))) :help "Paste (yank) text most recently cut/copied" :keys ,(lambda () (if cua-mode diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 4c52382c672..b8f5018005b 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1173,7 +1173,10 @@ allows editing it." (defun dictionary-lookup-definition () "Unconditionally lookup the word at point." (interactive) - (dictionary-new-search (cons (current-word) dictionary-default-dictionary))) + (let ((word (current-word))) + (unless word + (error "No word at point")) + (dictionary-new-search (cons word dictionary-default-dictionary)))) (defun dictionary-previous () "Go to the previous location in the current buffer." diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 35c0636b1cc..78107e1a03b 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -125,6 +125,8 @@ been set up by `rfn-eshadow-setup-minibuffer'." ;; eshell.el keeps the path in `eshell-path-env'. We must change it ;; when `default-directory' points to another host. +;; This is fixed in Eshell with Emacs 29.1. + (defun tramp-eshell-directory-change () "Set `eshell-path-env' to $PATH of the host related to `default-directory'." ;; Remove last element of `(exec-path)', which is `exec-directory'. @@ -136,16 +138,17 @@ been set up by `rfn-eshadow-setup-minibuffer'." (getenv "PATH")))) (with-eval-after-load 'esh-util - (add-hook 'eshell-mode-hook - #'tramp-eshell-directory-change) - (add-hook 'eshell-directory-change-hook - #'tramp-eshell-directory-change) - (add-hook 'tramp-integration-unload-hook - (lambda () - (remove-hook 'eshell-mode-hook - #'tramp-eshell-directory-change) - (remove-hook 'eshell-directory-change-hook - #'tramp-eshell-directory-change)))) + (unless (boundp 'eshell-path-env-list) + (add-hook 'eshell-mode-hook + #'tramp-eshell-directory-change) + (add-hook 'eshell-directory-change-hook + #'tramp-eshell-directory-change) + (add-hook 'tramp-integration-unload-hook + (lambda () + (remove-hook 'eshell-mode-hook + #'tramp-eshell-directory-change) + (remove-hook 'eshell-directory-change-hook + #'tramp-eshell-directory-change))))) ;;; Integration of recentf.el: diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3240f5352a7..d74afc84126 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -789,8 +789,8 @@ use strict; use warnings; use POSIX qw(getgroups); -my ($user, $passwd, $uid, $gid) = getpwuid $< ; -my $group = getgrgid $gid ; +my ( $uid, $user ) = ( $>, scalar getpwuid $> ); +my ( $gid, $group ) = ( $), scalar getgrgid $) ); my @groups = map { $_ . \"(\" . getgrgid ($_) . \")\" } getgroups (); printf \"uid=%%d(%%s) gid=%%d(%%s) groups=%%s\\n\", @@ -2827,11 +2827,14 @@ the result will be a local, non-Tramp, file name." ;; Handle empty NAME. (when (zerop (length name)) (setq name ".")) ;; On MS Windows, some special file names are not returned properly - ;; by `file-name-absolute-p'. - (if (and (eq system-type 'windows-nt) - (string-match-p - (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) - name)) + ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified', + ;; there could be the falso positive "/:". + (if (or (and (eq system-type 'windows-nt) + (string-match-p + (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) + name)) + (and (not (tramp-tramp-file-p name)) + (not (tramp-tramp-file-p dir)))) (tramp-run-real-handler #'expand-file-name (list name dir)) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index dc87c590b3b..bc8739c4d6c 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -369,33 +369,36 @@ the result will be a local, non-Tramp, file name." ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) - (with-parsed-tramp-file-name name nil - ;; Tilde expansion if necessary. We cannot accept "~/", because - ;; under sudo "~/" is expanded to the local user home directory - ;; but to the root home directory. - (when (zerop (length localname)) - (setq localname "~")) - (unless (file-name-absolute-p localname) - (setq localname (format "~%s/%s" user localname))) - (when (string-match - (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) - (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname)) - hname) - (when (zerop (length uname)) - (setq uname user)) - (when (setq hname (tramp-get-home-directory v uname)) - (setq localname (concat hname fname))))) - ;; Do not keep "/..". - (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) - (setq localname "/")) - ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../"). - (tramp-make-tramp-file-name - v (if (string-prefix-p "~" localname) - localname - (tramp-run-real-handler - #'expand-file-name (list localname)))))) + ;; If NAME is not a Tramp file, run the real handler. + (if (not (tramp-tramp-file-p name)) + (tramp-run-real-handler #'expand-file-name (list name)) + (with-parsed-tramp-file-name name nil + ;; Tilde expansion if necessary. We cannot accept "~/", because + ;; under sudo "~/" is expanded to the local user home directory + ;; but to the root home directory. + (when (zerop (length localname)) + (setq localname "~")) + (unless (file-name-absolute-p localname) + (setq localname (format "~%s/%s" user localname))) + (when (string-match + (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) + localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) + ;; Do not keep "/..". + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) + (setq localname "/")) + ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../"). + (tramp-make-tramp-file-name + v (if (string-prefix-p "~" localname) + localname + (tramp-run-real-handler + #'expand-file-name (list localname))))))) (defun tramp-sudoedit-remote-acl-p (vec) "Check, whether ACL is enabled on the remote host." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4ff57e5d560..c06adb01e8c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1526,7 +1526,8 @@ same connection. Make a copy in order to avoid side effects." ;; Comparison of file names is performed by `tramp-equal-remote'. (defun tramp-file-name-equal-p (vec1 vec2) - "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'." + "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'. +LOCALNAME and HOP do not count." (and (tramp-file-name-p vec1) (tramp-file-name-p vec2) (equal (tramp-file-name-unify vec1) (tramp-file-name-unify vec2)))) diff --git a/lisp/outline.el b/lisp/outline.el index b87d3ac5e7f..2209964577f 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -295,6 +295,9 @@ buffers (yet) -- that will be amended in a future version." (defvar-local outline--use-buttons nil "Non-nil when buffer displays clickable buttons on the headings.") +(defvar-local outline-minor-mode-insert-buttons nil + "Non-nil when it's allowed to modify buffer to insert buttons.") + (defvar-local outline--use-rtl nil "Non-nil when direction of clickable buttons is right-to-left.") @@ -339,17 +342,26 @@ Note that this feature is meant to be used in editing buffers." :version "29.1") (define-icon outline-open-in-margins outline-open - '((image "outline-open.svg" "outline-open.pbm" :height 10)) + '((image "outline-open.svg" "outline-open.pbm" :height 10) + (emoji "🔽") + (symbol "▼") + (text "v")) "Icon used for buttons for opened sections in margins." :version "29.1") (define-icon outline-close-in-margins outline-close - '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90)) + '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90) + (emoji "▶️") + (symbol "▶") + (text ">")) "Icon used for buttons for closed sections in margins." :version "29.1") (define-icon outline-close-rtl-in-margins outline-close-rtl - '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90)) + '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90) + (emoji "◀️") + (symbol "◀") + (text "<")) "Right-to-left icon used for closed sections in margins." :version "29.1") @@ -513,7 +525,8 @@ See the command `outline-mode' for more information on this mode." (setq-local left-margin-width (1+ left-margin-width))) (setq-local fringes-outside-margins t) ;; Force display of margins - (set-window-buffer nil (window-buffer))) + (when (eq (current-buffer) (window-buffer)) + (set-window-buffer nil (window-buffer)))) (when (or outline--use-buttons outline--use-margins) (add-hook 'after-change-functions #'outline--fix-buttons-after-change nil t)) @@ -551,7 +564,8 @@ See the command `outline-mode' for more information on this mode." (setq-local left-margin-width (1- left-margin-width))) (setq-local fringes-outside-margins nil) ;; Force removal of margins - (set-window-buffer nil (window-buffer))))) + (when (eq (current-buffer) (window-buffer)) + (set-window-buffer nil (window-buffer)))))) (defvar-local outline-heading-alist () "Alist associating a heading for every possible level. @@ -1657,18 +1671,24 @@ With a prefix argument, show headings up to that LEVEL." (if outline--use-rtl 'outline-close-rtl 'outline-close) - 'outline-open))) - (inhibit-read-only t)) + 'outline-open)))) ;; In editing buffers we use overlays only, but in other buffers ;; we use a mix of text properties, text and overlays to make ;; movement commands work more logically. - (when (derived-mode-p 'special-mode) - (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face))) - (if-let ((image (plist-get icon 'image))) - (overlay-put o 'display image) - (overlay-put o 'display (concat (plist-get icon 'string) - (string (char-after (point))))) - (overlay-put o 'face (plist-get icon 'face)))) + (if outline-minor-mode-insert-buttons + (let ((inhibit-read-only t)) + (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face)) + (if-let ((image (plist-get icon 'image))) + (overlay-put o 'display image) + (overlay-put o 'display (concat (plist-get icon 'string) + (string (char-after (point))))) + (overlay-put o 'face (plist-get icon 'face)))) + (overlay-put + o 'before-string + (propertize " " + 'display + (or (plist-get icon 'image) + (plist-get icon 'string)))))) o)) (defun outline--make-margin-overlay (type) @@ -1699,7 +1719,7 @@ With a prefix argument, show headings up to that LEVEL." (beginning-of-line) (if use-margins (outline--make-margin-overlay 'open) - (when (derived-mode-p 'special-mode) + (when outline-minor-mode-insert-buttons (let ((inhibit-read-only t)) (insert " ") (beginning-of-line))) @@ -1716,7 +1736,7 @@ With a prefix argument, show headings up to that LEVEL." (beginning-of-line) (if use-margins (outline--make-margin-overlay 'close) - (when (derived-mode-p 'special-mode) + (when outline-minor-mode-insert-buttons (let ((inhibit-read-only t)) (insert " ") (beginning-of-line))) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 4f1a08cfa06..81aac2ec274 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -60,7 +60,6 @@ (cc-bytecomp-defun region-active-p) ; XEmacs (cc-bytecomp-defvar mark-active) ; Emacs (cc-bytecomp-defvar deactivate-mark) ; Emacs -(cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs (cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs (cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21 (cc-bytecomp-defun string-to-syntax) ; Emacs 21 diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 223b1e917fe..596cccdf48e 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9055,7 +9055,8 @@ multi-line strings (but not C++, for example)." (c-forward-<>-arglist t) (c-forward-syntactic-ws)) - (let ((start (point)) pos res name-res id-start id-end id-range) + (let ((start (point)) pos res name-res id-start id-end id-range + post-prefix-pos) ;; Skip leading type modifiers. If any are found we know it's a ;; prefix of a type. @@ -9067,6 +9068,7 @@ multi-line strings (but not C++, for example)." (c-forward-syntactic-ws) (or (eq res 'no-id) (setq res 'prefix)))) + (setq post-prefix-pos (point)) (cond ((looking-at c-typeof-key) ; e.g. C++'s "decltype". @@ -9099,9 +9101,12 @@ multi-line strings (but not C++, for example)." (setq name-res (c-forward-name)) (setq res (not (null name-res))) (when (eq name-res t) - ;; In many languages the name can be used without the - ;; prefix, so we add it to `c-found-types'. - (c-add-type pos (point)) + ;; With some keywords the name can be used without the prefix, so we + ;; add the name to `c-found-types' when this is the case. + (when (save-excursion + (goto-char post-prefix-pos) + (looking-at c-self-contained-typename-key)) + (c-add-type pos (point))) (when (and c-record-type-identifiers c-last-identifier-range) (c-record-type-id c-last-identifier-range))) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index b17718cfd54..6ccd6c30df9 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2294,11 +2294,22 @@ declaration with a type as a default value. This is used only in C++ Mode, e.g. \"<typename X = Y>\"." t nil c++ '("class" "typename")) - (c-lang-defconst c-template-typename-key t (c-make-keywords-re t (c-lang-const c-template-typename-kwds))) (c-lang-defvar c-template-typename-key (c-lang-const c-template-typename-key)) +(c-lang-defconst c-self-contained-typename-kwds + "Keywords where the following name is a type name which can be +used in declarations without the keyword." + t nil + c++ '("typename")) + +(c-lang-defconst c-self-contained-typename-key + ;; Adorned regexp matching `c-self-contained-typename-key'. + t (c-make-keywords-re t (c-lang-const c-self-contained-typename-kwds))) +(c-lang-defvar c-self-contained-typename-key + (c-lang-const c-self-contained-typename-key)) + (c-lang-defconst c-type-prefix-kwds "Keywords where the following name - if any - is a type name, and where the keyword together with the symbol works as a type in diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 7e7ea6aeb9e..537b9484bd5 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1826,8 +1826,8 @@ or elsewhere, return a 1-line docstring." (eq 'function (aref elisp--eldoc-last-data 2))) (aref elisp--eldoc-last-data 1)) (t - (let* ((advertised (gethash (indirect-function sym) - advertised-signature-table t)) + (let* ((advertised (get-advertised-calling-convention + (indirect-function sym))) doc (args (cond diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 58d7a2026eb..6791e2fc9f8 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,7 +1,6 @@ ;;; fortran.el --- Fortran mode for GNU Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1986, 1993-1995, 1997-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1986-2022 Free Software Foundation, Inc. ;; Author: Michael D. Prange <prange@erl.mit.edu> ;; Maintainer: emacs-devel@gnu.org @@ -624,34 +623,32 @@ Used in the Fortran entry in `hs-special-modes-alist'.") st) "Syntax table used to parse Fortran expressions for printing in GUD.") -(defvar fortran-mode-map - (let ((map (make-sparse-keymap))) - (define-key map ";" 'fortran-abbrev-start) - (define-key map "\C-c;" 'fortran-comment-region) - ;; The default comment-dwim does at least as much as this. -;;; (define-key map "\M-;" 'fortran-indent-comment) - (define-key map "\M-\n" 'fortran-split-line) - (define-key map "\M-\C-n" 'fortran-end-of-block) - (define-key map "\M-\C-p" 'fortran-beginning-of-block) - (define-key map "\M-\C-q" 'fortran-indent-subprogram) - (define-key map "\C-c\C-w" 'fortran-window-create-momentarily) - (define-key map "\C-c\C-r" 'fortran-column-ruler) - (define-key map "\C-c\C-p" 'fortran-previous-statement) - (define-key map "\C-c\C-n" 'fortran-next-statement) - (define-key map "\C-c\C-d" 'fortran-join-line) ; like f90 - (define-key map "\M-^" 'fortran-join-line) ; subvert delete-indentation - (define-key map "0" 'fortran-electric-line-number) - (define-key map "1" 'fortran-electric-line-number) - (define-key map "2" 'fortran-electric-line-number) - (define-key map "3" 'fortran-electric-line-number) - (define-key map "4" 'fortran-electric-line-number) - (define-key map "5" 'fortran-electric-line-number) - (define-key map "6" 'fortran-electric-line-number) - (define-key map "7" 'fortran-electric-line-number) - (define-key map "8" 'fortran-electric-line-number) - (define-key map "9" 'fortran-electric-line-number) - map) - "Keymap used in Fortran mode.") +(defvar-keymap fortran-mode-map + :doc "Keymap used in Fortran mode." + ";" #'fortran-abbrev-start + "C-c ;" #'fortran-comment-region + ;; The default comment-dwim does at least as much as this. + ;; "M-;" #'fortran-indent-comment + "C-M-j" #'fortran-split-line + "C-M-n" #'fortran-end-of-block + "C-M-p" #'fortran-beginning-of-block + "C-M-q" #'fortran-indent-subprogram + "C-c C-w" #'fortran-window-create-momentarily + "C-c C-r" #'fortran-column-ruler + "C-c C-p" #'fortran-previous-statement + "C-c C-n" #'fortran-next-statement + "C-c C-d" #'fortran-join-line ; like f90 + "M-^" #'fortran-join-line ; subvert delete-indentation + "0" #'fortran-electric-line-number + "1" #'fortran-electric-line-number + "2" #'fortran-electric-line-number + "3" #'fortran-electric-line-number + "4" #'fortran-electric-line-number + "5" #'fortran-electric-line-number + "6" #'fortran-electric-line-number + "7" #'fortran-electric-line-number + "8" #'fortran-electric-line-number + "9" #'fortran-electric-line-number) (define-abbrev-table 'fortran-mode-abbrev-table diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 0de76b0bde3..11195894234 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4080,15 +4080,18 @@ using that one instead of current buffer's process." (buffer-substring-no-properties line-start (point))) (buffer-substring-no-properties line-start (point)))) (start - (save-excursion - (if (not (re-search-backward - (python-rx - (or whitespace open-paren close-paren string-delimiter simple-operator)) - line-start - t 1)) - line-start - (forward-char (length (match-string-no-properties 0))) - (point)))) + (if (< (point) line-start) + (point) + (save-excursion + (if (not (re-search-backward + (python-rx + (or whitespace open-paren close-paren + string-delimiter simple-operator)) + line-start + t 1)) + line-start + (forward-char (length (match-string-no-properties 0))) + (point))))) (end (point)) (prompt-boundaries (with-current-buffer (process-buffer process) @@ -4102,7 +4105,10 @@ using that one instead of current buffer's process." (with-current-buffer (process-buffer process) (cond ((or (null prompt) (and is-shell-buffer - (< (point) (cdr prompt-boundaries)))) + (< (point) (cdr prompt-boundaries))) + (and (not is-shell-buffer) + (string-match-p + python-shell-prompt-pdb-regexp prompt))) #'ignore) ((or (not python-shell-completion-native-enable) ;; Even if native completion is enabled, for diff --git a/lisp/subr.el b/lisp/subr.el index 56ce9fa69b9..08dfe7aa430 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -344,7 +344,7 @@ in compilation warnings about unused variables. ;; FIXME: This let often leads to "unused var" warnings. `((let ((,var ,counter)) ,@(cddr spec))))))) -(defmacro declare (&rest _specs) +(defmacro declare (&rest specs) "Do not evaluate any arguments, and return nil. If a `declare' form appears as the first form in the body of a `defun' or `defmacro' form, SPECS specifies various additional @@ -355,8 +355,16 @@ The possible values of SPECS are specified by `defun-declarations-alist' and `macro-declarations-alist'. For more information, see info node `(elisp)Declare Form'." - ;; FIXME: edebug spec should pay attention to defun-declarations-alist. - nil) + ;; `declare' is handled directly by `defun/defmacro' rather than here. + ;; If we get here, it's because there's a `declare' somewhere not attached + ;; to a `defun/defmacro', i.e. a `declare' which doesn't do what it's + ;; intended to do. + (let ((form `(declare . ,specs))) ;; FIXME: WIBNI we had &whole? + (macroexp-warn-and-return + (format-message "Stray `declare' form: %S" form) + ;; Make a "unique" harmless form to circumvent + ;; the cache in `macroexp-warn-and-return'. + `(progn ',form nil) nil 'compile-only))) (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index d9decae4df6..d57d053a7ad 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -73,12 +73,9 @@ (defun emacs-news--mode-common () (setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t)) - ;; This `outline-regexp' matches leading spaces inserted - ;; by the current implementation of `outline-minor-mode-use-buttons'. - (setq-local outline-regexp "\\(?: +\\)?\\(\\*+\\) " - outline-level (lambda () (length (match-string 1))) - outline-minor-mode-cycle t - outline-minor-mode-highlight 'append) + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight 'append + outline-minor-mode-use-margins t) (outline-minor-mode) (setq-local imenu-generic-expression outline-imenu-generic-expression) (emacs-etc--hide-local-variables)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 76b8970b5b4..7f603093e11 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1689,6 +1689,50 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." backend patch-string)) +(defun vc-default-checkin-patch (_backend patch-string comment) + (pcase-let* ((`(,backend ,files) (with-temp-buffer + (insert patch-string) + (diff-vc-deduce-fileset))) + (tmpdir (make-temp-file "vc-checkin-patch" t))) + (dolist (f files) + (make-directory (file-name-directory (expand-file-name f tmpdir)) t) + (copy-file (expand-file-name f) + (expand-file-name f tmpdir))) + (unwind-protect + (progn + (dolist (f files) + (with-current-buffer (find-file-noselect f) + (vc-revert-file buffer-file-name))) + (with-temp-buffer + ;; Trying to support CVS too. Assuming that vc-diff + ;; there will usually have diff root in default-directory. + (when (vc-find-backend-function backend 'root) + (setq-local default-directory + (vc-call-backend backend 'root (car files)))) + (unless (eq 0 + (call-process-region patch-string + nil + "patch" + nil + t + nil + "-p1" + "-r" null-device + "--no-backup-if-mismatch" + "-i" "-")) + (user-error "Patch failed: %s" (buffer-string)))) + (dolist (f files) + (with-current-buffer (get-file-buffer f) + (revert-buffer t t t))) + (vc-call-backend backend 'checkin files comment)) + (dolist (f files) + (copy-file (expand-file-name f tmpdir) + (expand-file-name f) + t) + (with-current-buffer (get-file-buffer f) + (revert-buffer t t t))) + (delete-directory tmpdir t)))) + ;;; Additional entry points for examining version histories ;; (defun vc-default-diff-tree (backend dir rev1 rev2) @@ -3377,12 +3421,12 @@ revisions, those revisions will be used." revisions))) (if vc-prepare-patches-separately (dolist (patch (reverse patches) - (message "Prepared %d patches..." (length patches))) + (message "Prepared %d patch%s..." (length patches) + (if (length> patches 1) "es" ""))) (compose-mail addressee (plist-get patch :subject) nil nil nil nil - `((kill-buffer ,(plist-get patch :buffer)) - (exit-recursive-edit))) + `((kill-buffer ,(plist-get patch :buffer)))) (rfc822-goto-eoh) (forward-line) (save-excursion ;don't jump to the end (insert-buffer-substring |