commit 5e55b1b82952a03b704c464e8086d3c41e993a46 (HEAD, refs/remotes/origin/master) Author: Mauro Aranda Date: Sat Mar 23 11:38:14 2019 -0300 Avoid recursive load of eshell * lisp/eshell/eshell.el: Provide eshell before requiring esh-mode to avoid a recursive load when esh-mode requires esh-module (which in turn requires eshell). (Bug #34954) The double loading can be noticed by entries in 'eshell-load-hook' or forms passed to (with-eval-after-load 'eshell ...). diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 4516800756..c7ed7103e4 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -175,6 +175,9 @@ (eval-when-compile (require 'cl-lib)) (require 'esh-util) +;; Provide eshell before requiring esh-mode, to avoid a recursive load. +;; (Bug #34954) +(provide 'eshell) (require 'esh-mode) (defgroup eshell nil @@ -403,6 +406,4 @@ Emacs." (run-hooks 'eshell-load-hook) -(provide 'eshell) - ;;; eshell.el ends here commit 64925714ef6b4d7485e5aee7a8ac063c20c07bc5 Author: Mauro Aranda Date: Mon Mar 25 10:38:39 2019 -0300 Fix repeated 'custom-add-option' in esh-mode.el (Bug#34993) * lisp/eshell/esh-mode.el: Call 'custom-add-option' with the right argument. diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 30298763a5..0a160b9ab3 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -551,7 +551,7 @@ Putting this function on `eshell-pre-command-hook' will mimic Plan 9's 9term behavior." (goto-char eshell-last-input-start)) -(custom-add-option 'eshell-pre-command-hook 'eshell-push-command-mark) +(custom-add-option 'eshell-pre-command-hook 'eshell-goto-input-start) (defsubst eshell-interactive-print (string) "Print STRING to the eshell display buffer." commit 8147d3c27cbf29e18dbdd6bad21cd17bc880a8d3 Author: Michael Albinus Date: Wed Apr 3 21:36:40 2019 +0200 Work on asynchronous processes for tramp-adb.el * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): Simplify. Remove echoed first line. (tramp-adb-send-command): Add NEVEROPEN and NOOUTPUT. * lisp/net/tramp-sh.el (tramp-process-sentinel): Remove. (tramp-sh-handle-make-process): Simplify. * lisp/net/tramp.el (tramp-process-sentinel): New defun, taken from tramp-sh.el. Delete trailing shell prompt. * test/lisp/net/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Run also for tramp-adb. (tramp-test32-shell-command): Remove tramp-adb restrictions. (tramp-test34-explicit-shell-file-name): Rework. Remove :unstable tag. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 68960426b6..db9acbfc63 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -968,7 +968,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (program (car command)) (args (cdr command)) (command - (format "cd %s; %s" + (format "cd %s && exec %s" (tramp-shell-quote-argument localname) (mapconcat #'tramp-shell-quote-argument (cons program args) " "))) @@ -1000,24 +1000,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; otherwise we might be interrupted by ;; `verify-visited-file-modtime'. (let ((buffer-undo-list t) - (inhibit-read-only t) - (mark (point))) + (inhibit-read-only t)) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) ;; We call `tramp-adb-maybe-open-connection', in ;; order to cleanup the prompt afterwards. (tramp-adb-maybe-open-connection v) - (widen) - (delete-region mark (point-max)) - (narrow-to-region (point-max) (point-max)) + (delete-region (point-min) (point-max)) ;; Send the command. - (let* ((p (tramp-get-connection-process v)) - (prompt - (tramp-get-connection-property p "prompt" nil))) - (tramp-set-connection-property - p "prompt" (regexp-quote command)) - (tramp-adb-send-command v command) - (tramp-set-connection-property p "prompt" prompt) + (let* ((p (tramp-get-connection-process v))) + (tramp-adb-send-command v command nil t) ; nooutput ;; Stop process if indicated. (when stop (stop-process p)) @@ -1032,6 +1024,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (ignore-errors (set-process-query-on-exit-flag p (null noquery)) (set-marker (process-mark p) (point))) + ;; Read initial output. Remove the first line, + ;; which is the command echo. + (while + (progn + (goto-char (point-min)) + (not (re-search-forward "[\n]" nil t))) + (tramp-accept-process-output p 0)) + (delete-region (point-min) (point)) ;; Return process. p)))) @@ -1119,26 +1119,27 @@ This happens for Android >= 4.0." ;; Connection functions -(defun tramp-adb-send-command (vec command) +(defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (tramp-adb-maybe-open-connection vec) + (unless neveropen (tramp-adb-maybe-open-connection vec)) (tramp-message vec 6 "%s" command) (tramp-send-string vec command) - ;; FIXME: Race condition. - (tramp-adb-wait-for-output (tramp-get-connection-process vec)) - (with-current-buffer (tramp-get-connection-buffer vec) - (save-excursion - (goto-char (point-min)) - ;; We can't use stty to disable echo of command. stty is said - ;; to be added to toybox 0.7.6. busybox shall have it, but this - ;; isn't used any longer for Android. - (delete-matching-lines (regexp-quote command)) - ;; When the local machine is W32, there are still trailing ^M. - ;; There must be a better solution by setting the correct coding - ;; system, but this requires changes in core Tramp. - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" nil nil))))) + (unless nooutput + ;; FIXME: Race condition. + (tramp-adb-wait-for-output (tramp-get-connection-process vec)) + (with-current-buffer (tramp-get-connection-buffer vec) + (save-excursion + (goto-char (point-min)) + ;; We can't use stty to disable echo of command. stty is said + ;; to be added to toybox 0.7.6. busybox shall have it, but this + ;; isn't used any longer for Android. + (delete-matching-lines (regexp-quote command)) + ;; When the local machine is W32, there are still trailing ^M. + ;; There must be a better solution by setting the correct coding + ;; system, but this requires changes in core Tramp. + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" nil nil)))))) (defun tramp-adb-send-command-and-check (vec command) "Run COMMAND and check its exit status. @@ -1245,6 +1246,9 @@ connection if a previous connection has died for some reason." (tramp-adb-wait-for-output p 30) (unless (process-live-p p) (tramp-error vec 'file-error "Terminated!")) + + ;; Set sentinel and query flag. Initialize variables. + (set-process-sentinel p #'tramp-process-sentinel) (process-put p 'vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index edd9af489e..7d903c5769 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2769,15 +2769,6 @@ the result will be a local, non-Tramp, file name." ;;; Remote commands: -(defun tramp-process-sentinel (proc event) - "Flush file caches." - (unless (process-live-p proc) - (let ((vec (process-get proc 'vector))) - (when vec - (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event) - (tramp-flush-connection-properties proc) - (tramp-flush-directory-properties vec ""))))) - ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. @@ -2912,8 +2903,7 @@ the result will be a local, non-Tramp, file name." ;; otherwise we might be interrupted by ;; `verify-visited-file-modtime'. (let ((buffer-undo-list t) - (inhibit-read-only t) - (mark (point-max))) + (inhibit-read-only t)) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max)) ;; We call `tramp-maybe-open-connection', in @@ -2926,9 +2916,7 @@ the result will be a local, non-Tramp, file name." (let ((pid (tramp-send-command-and-read v "echo $$"))) (process-put p 'remote-pid pid) (tramp-set-connection-property p "remote-pid" pid)) - (widen) - (delete-region mark (point-max)) - (narrow-to-region (point-max) (point-max)) + (delete-region (point-min) (point-max)) ;; Now do it. (if command ;; Send the command. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7206d8eb8a..0fc2d33d22 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4212,6 +4212,19 @@ the remote host use line-endings as defined in the variable ;; Reenable the timers. (with-timeout-unsuspend stimers)))) +(defun tramp-process-sentinel (proc event) + "Flush file caches and remove shell prompt." + (unless (process-live-p proc) + (let ((vec (process-get proc 'vector)) + (prompt (tramp-get-connection-property proc "prompt" nil))) + (when vec + (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event) + (tramp-flush-connection-properties proc) + (tramp-flush-directory-properties vec "")) + (goto-char (point-max)) + (when (and prompt (re-search-backward (regexp-quote prompt) nil t)) + (delete-region (point) (point-max)))))) + (defun tramp-get-inode (vec) "Returns the virtual inode number. If it doesn't exist, generate a new one." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1c7198ce56..1ee11f0d38 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3849,12 +3849,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `start-file-process'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) (tmp-name (tramp--test-make-temp-name nil quoted)) kill-buffer-query-functions proc) + + ;; Simple process. (unwind-protect (with-temp-buffer (setq proc (start-file-process "test1" (current-buffer) "cat")) @@ -3866,11 +3868,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - (should (string-equal (buffer-string) "foo"))) + ;; We cannot use `string-equal', because tramp-adb.el + ;; echoes also the sent string. + (should (string-match "\\`foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) + ;; Simple process using a file. (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) @@ -3891,6 +3896,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-process proc) (delete-file tmp-name))) + ;; Process filter. (unwind-protect (with-temp-buffer (setq proc (start-file-process "test3" (current-buffer) "cat")) @@ -3905,7 +3911,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - (should (string-equal (buffer-string) "foo"))) + ;; We cannot use `string-equal', because tramp-adb.el + ;; echoes also the sent string. + (should (string-match "\\`foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc)))))) @@ -3914,7 +3922,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `make-process'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (skip-unless (tramp--test-emacs27-p)) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) @@ -3938,7 +3946,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-timeout (10 (tramp--test-timeout-handler)) (while (< (- (point-max) (point-min)) (length "foo")) (while (accept-process-output proc 0 nil t)))) - (should (string-equal (buffer-string) "foo"))) + ;; We cannot use `string-equal', because tramp-adb.el + ;; echoes also the sent string. + (should (string-match "\\`foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) @@ -3981,9 +3991,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) - (while (< (- (point-max) (point-min)) (length "foo")) + (while (not (string-match "foo" (buffer-string))) (while (accept-process-output proc 0 nil t)))) - (should (string-equal (buffer-string) "foo"))) + ;; We cannot use `string-equal', because tramp-adb.el + ;; echoes also the sent string. + (should (string-match "\\`foo" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) @@ -4006,33 +4018,37 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) (while (accept-process-output proc 0 nil t))) - (should (string-equal (buffer-string) "killed\n"))) + ;; We cannot use `string-equal', because tramp-adb.el + ;; echoes also the sent string. + (should (string-match "killed\n\\'" (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Process with stderr. - (let ((stderr (generate-new-buffer (generate-new-buffer-name "stderr")))) - (unwind-protect - (with-temp-buffer - (setq proc - (make-process - :name "test5" :buffer (current-buffer) - :command '("cat" "/") - :stderr stderr - :file-handler t)) - (should (processp proc)) - ;; Read stderr. - (with-current-buffer stderr - (with-timeout (10 (tramp--test-timeout-handler)) - (while (= (point-min) (point-max)) - (while (accept-process-output proc 0 nil t)))) - (should - (string-equal (buffer-string) "cat: /: Is a directory\n")))) + ;; Process with stderr. tramp-adb.el doesn't support it (yet). + (unless (tramp--test-adb-p) + (let ((stderr + (generate-new-buffer (generate-new-buffer-name "stderr")))) + (unwind-protect + (with-temp-buffer + (setq proc + (make-process + :name "test5" :buffer (current-buffer) + :command '("cat" "/") + :stderr stderr + :file-handler t)) + (should (processp proc)) + ;; Read stderr. + (with-current-buffer stderr + (with-timeout (10 (tramp--test-timeout-handler)) + (while (= (point-min) (point-max)) + (while (accept-process-output proc 0 nil t)))) + (should + (string-equal (buffer-string) "cat: /: Is a directory\n")))) - ;; Cleanup. - (ignore-errors (delete-process proc)) - (ignore-errors (kill-buffer stderr))))))) + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (kill-buffer stderr)))))))) (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." @@ -4096,8 +4112,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-file tmp-name))) - ;; tramp-adb.el is not fit yet for asynchronous processes. - (unless (tramp--test-adb-p) (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) @@ -4124,10 +4138,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name)))) + (ignore-errors (delete-file tmp-name))) - ;; tramp-adb.el is not fit yet for asynchronous processes. - (unless (tramp--test-adb-p) (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) @@ -4155,7 +4167,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name))))))) + (ignore-errors (delete-file tmp-name)))))) (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." @@ -4350,9 +4362,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test34-explicit-shell-file-name () "Check that connection-local `explicit-shell-file-name' is set." - ;; The handling of connection-local variables has changed. Test - ;; must be reworked. - :tags '(:expensive-test :unstable) + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) ;; Since Emacs 26.1. @@ -4368,15 +4378,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unwind-protect (progn ;; `shell-mode' would ruin our test, because it deletes all - ;; buffer local variables. + ;; buffer local variables. Not needed in Emacs 27.1. (put 'explicit-shell-file-name 'permanent-local t) - ;; Declare connection-local variable `explicit-shell-file-name'. + ;; Declare connection-local variables `explicit-shell-file-name' + ;; and `explicit-sh-args'. (with-no-warnings (connection-local-set-profile-variables 'remote-sh `((explicit-shell-file-name . ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")) - (explicit-sh-args . ("-i")))) + (explicit-sh-args . ("-c" "echo foo")))) (connection-local-set-profiles `(:application tramp :protocol ,(file-remote-p default-directory 'method) @@ -4386,14 +4397,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (put 'explicit-shell-file-name 'safe-local-variable #'identity) (put 'explicit-sh-args 'safe-local-variable #'identity) - ;; Run interactive shell. Since the default directory is - ;; remote, `explicit-shell-file-name' shall be set in order - ;; to avoid a question. + ;; Run `shell' interactively. Since the default directory + ;; is remote, `explicit-shell-file-name' shall be set in + ;; order to avoid a question. `explicit-sh-args' echoes the + ;; test data. (with-current-buffer (get-buffer-create "*shell*") (ignore-errors (kill-process (current-buffer))) (should-not explicit-shell-file-name) (call-interactively #'shell) - (should explicit-shell-file-name))) + (with-timeout (10) + (while (accept-process-output + (get-buffer-process (current-buffer)) nil nil t))) + (should (string-match "^foo$" (buffer-string))))) ;; Cleanup. (put 'explicit-shell-file-name 'permanent-local nil) @@ -5714,11 +5729,8 @@ Since it unloads Tramp, it shall be the last test to run." ;; do not work properly for `nextcloud'. ;; * Fix `tramp-test29-start-file-process' and ;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). -;; * Fix `tramp-test29-start-file-process', -;; `tramp-test30-make-process' and `tramp-test32-shell-command' for -;; `adb' (see comment in `tramp-adb-send-command'). -;; * Rework `tramp-test34-explicit-shell-file-name'. ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. +;; * Fix `tramp-test44-threads'. (provide 'tramp-tests) ;;; tramp-tests.el ends here commit ce9490cb314694b95847ac647b35f1319ba80fde Author: Glenn Morris Date: Wed Apr 3 15:20:50 2019 -0400 * test/lisp/progmodes/flymake-tests.el (different-diagnostic-types): Expect failure on hydra.nixos. diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index 629cdf9a13..732193476d 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -142,6 +142,8 @@ SEVERITY-PREDICATE is used to setup (ert-deftest different-diagnostic-types () "Test GCC warning via function predicate." + ;; http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg01043.html + :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) (skip-unless (and (executable-find "gcc") (version<= "5" (string-trim commit 2bcf0f097cd6841af5844d3a2a9d670ba4daea99 Author: Eli Zaretskii Date: Wed Apr 3 20:41:47 2019 +0300 Improve commentary in 'field_relpos' * src/pdumper.c (PDUMPER_MAX_OBJECT_SIZE): New macro. (field_relpos): Use PDUMPER_MAX_OBJECT_SIZE, and comment on why we require that relpos be not too large. diff --git a/src/pdumper.c b/src/pdumper.c index 7fabfa771c..b19f206d1b 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -1777,6 +1777,8 @@ dump_roots (struct dump_context *ctx) visit_static_gc_roots (visitor); } +#define PDUMPER_MAX_OBJECT_SIZE 2048 + static dump_off field_relpos (const void *in_start, const void *in_field) { @@ -1784,7 +1786,15 @@ field_relpos (const void *in_start, const void *in_field) ptrdiff_t in_field_val = (ptrdiff_t) in_field; eassert (in_start_val <= in_field_val); ptrdiff_t relpos = in_field_val - in_start_val; - eassert (relpos < 1024); /* Sanity check. */ + /* The following assertion attempts to detect bugs whereby IN_START + and IN_FIELD don't point to the same object/structure, on the + assumption that a too-large difference between them is + suspicious. As of Apr 2019 the largest object we dump -- 'struct + buffer' -- is slightly smaller than 1KB, and we want to leave + some margin for future extensions. If the assertion below is + ever violated, make sure the two pointers indeed point into the + same object, and if so, enlarge the value of PDUMPER_MAX_OBJECT_SIZE. */ + eassert (relpos < PDUMPER_MAX_OBJECT_SIZE); return (dump_off) relpos; } commit b29b79efd9752caf1e99273575a00b6769ddad56 Author: Eli Zaretskii Date: Wed Apr 3 20:30:23 2019 +0300 Restore process-environment after portable dumping * src/pdumper.c (struct dump_context): New member old_process_environment. (Fdump_emacs_portable): Record the original value of process-environment. (dump_unwind_cleanup): Restore the original values of process-environment and post-gc-hook. diff --git a/src/pdumper.c b/src/pdumper.c index 53a10b62b3..7fabfa771c 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -495,6 +495,7 @@ struct dump_context Lisp_Object old_purify_flag; Lisp_Object old_post_gc_hook; + Lisp_Object old_process_environment; #ifdef REL_ALLOC bool blocked_ralloc; @@ -3593,6 +3594,8 @@ dump_unwind_cleanup (void *data) r_alloc_inhibit_buffer_relocation (0); #endif Vpurify_flag = ctx->old_purify_flag; + Vpost_gc_hook = ctx->old_post_gc_hook; + Vprocess_environment = ctx->old_process_environment; } /* Return DUMP_OFFSET, making sure it is within the heap. */ @@ -4024,12 +4027,6 @@ types. */) Lisp_Object symbol = intern ("command-line-processed"); specbind (symbol, Qnil); - /* Reset process-environment -- this is for when they re-dump a - pdump-restored emacs, since set_initial_environment wants always - to cons it from scratch. */ - Vprocess_environment = Qnil; - garbage_collect (); - CHECK_STRING (filename); filename = Fexpand_file_name (filename, Qnil); filename = ENCODE_FILE (filename); @@ -4091,6 +4088,12 @@ types. */) ctx->old_post_gc_hook = Vpost_gc_hook; Vpost_gc_hook = Qnil; + /* Reset process-environment -- this is for when they re-dump a + pdump-restored emacs, since set_initial_environment wants always + to cons it from scratch. */ + ctx->old_process_environment = Vprocess_environment; + Vprocess_environment = Qnil; + ctx->fd = emacs_open (SSDATA (filename), O_RDWR | O_TRUNC | O_CREAT, 0666); if (ctx->fd < 0) commit 9df0b8d166a3b3805c20e10885f15f9e35de7ec6 Author: Stephen Leake Date: Wed Apr 3 10:25:45 2019 -0700 Fix bug in gud-gdb-marker-filter: first marker does not start with \n diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 92f5205a6d..4306f5daa0 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -678,7 +678,7 @@ The option \"--fullname\" must be included in this value." ;; gud-marker-acc until we receive the rest of it. Since we ;; know the full marker regexp above failed, it's pretty simple to ;; test for marker starts. - (if (string-match "\n\\(\032.*\\)?\\'" gud-marker-acc) + (if (string-match "\\(\n\\)?\\(\032.*\\)?\\'" gud-marker-acc) (progn ;; Everything before the potential marker start can be output. (setq output (concat output (substring gud-marker-acc commit 0e468a620458fecd003c396050aa6deb722982c1 Author: Basil L. Contovounesios Date: Tue Apr 2 00:56:04 2019 +0100 Avoid using obsolete indent-relative-maybe * lisp/electric.el (electric-indent-functions-without-reindent): * lisp/indent.el (indent-according-to-mode): Check for indent-relative-first-indent-point in addition to its obsolete alias indent-relative-maybe. * lisp/obsolete/vi.el (vi-com-map): Use indent-relative-first-indent-point in place of its obsolete alias indent-relative-maybe. diff --git a/lisp/electric.el b/lisp/electric.el index 657913a396..07da2f1d9e 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -223,9 +223,9 @@ Python does not lend itself to fully automatic indentation.") (defvar electric-indent-functions-without-reindent '(indent-relative indent-to-left-margin indent-relative-maybe - py-indent-line coffee-indent-line org-indent-line yaml-indent-line - haskell-indentation-indent-line haskell-indent-cycle haskell-simple-indent - yaml-indent-line) + indent-relative-first-indent-point py-indent-line coffee-indent-line + org-indent-line yaml-indent-line haskell-indentation-indent-line + haskell-indent-cycle haskell-simple-indent yaml-indent-line) "List of indent functions that can't reindent. If `indent-line-function' is one of those, then `electric-indent-mode' will not try to reindent lines. It is normally better to make the major diff --git a/lisp/indent.el b/lisp/indent.el index 34757a43d7..f3d3158faa 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -65,15 +65,17 @@ e.g., `c-tab-always-indent', and do not respect this variable." "Indent line in proper way for current major mode. Normally, this is done by calling the function specified by the variable `indent-line-function'. However, if the value of that -variable is `indent-relative' or `indent-relative-maybe', handle -it specially (since those functions are used for tabbing); in -that case, indent by aligning to the previous non-blank line." +variable is `indent-relative' or `indent-relative-first-indent-point', +handle it specially (since those functions are used for tabbing); +in that case, indent by aligning to the previous non-blank line." (interactive) (save-restriction (widen) (syntax-propertize (line-end-position)) (if (memq indent-line-function - '(indent-relative indent-relative-maybe)) + '(indent-relative + indent-relative-maybe + indent-relative-first-indent-point)) ;; These functions are used for tabbing, but can't be used for ;; indenting. Replace with something ad-hoc. (let ((column (save-excursion diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el index 7d44f561d4..df5ddfdbcf 100644 --- a/lisp/obsolete/vi.el +++ b/lisp/obsolete/vi.el @@ -132,7 +132,7 @@ command extensions.") (define-key vi-com-map "\C-e" 'vi-expose-line-below) (define-key vi-com-map "\C-f" 'vi-forward-windowful) (define-key vi-com-map "\C-g" 'keyboard-quit) - (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB + (define-key vi-com-map "\C-i" 'indent-relative-first-indent-point) ; TAB (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension (define-key vi-com-map "\C-l" 'recenter) commit 32e19b2baee081b400b0f23428963f1412114961 Author: Stefan Monnier Date: Wed Apr 3 11:24:12 2019 -0400 * lisp/progmodes/compile.el: Use non-nil values for *-function (compilation-parse-errors-filename-function,compilation-exit-message-function) (compilation-process-setup-function, compilation-buffer-name-function): Give them non-nil default values. (compilation-buffer-name): Restructure slightly. (compilation--default-buffer-name): New function, extracted from it. Use `name-of-mode` instead of `mode-command` to check if the current buffer is already in the appropriate mode. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 4018cf7022..5bfb0bf901 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -77,7 +77,7 @@ If this is buffer-local in the destination buffer, Emacs obeys that value, otherwise it uses the value in the *compilation* buffer. This enables a major-mode to specify its own value.") -(defvar compilation-parse-errors-filename-function nil +(defvar compilation-parse-errors-filename-function #'identity "Function to call to post-process filenames while parsing error messages. It takes one arg FILENAME which is the name of a file as found in the compilation output, and should return a transformed file name @@ -86,18 +86,18 @@ or a buffer, the one which was compiled.") ;; match data. ;;;###autoload -(defvar compilation-process-setup-function nil +(defvar compilation-process-setup-function #'ignore "Function to call to customize the compilation process. This function is called immediately before the compilation process is started. It can be used to set any variables or functions that are used while processing the output of the compilation process.") ;;;###autoload -(defvar compilation-buffer-name-function nil +(defvar compilation-buffer-name-function #'compilation--default-buffer-name "Function to compute the name of a compilation buffer. The function receives one argument, the name of the major mode of the compilation buffer. It should return a string. -If nil, compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.") +By default, it returns `(concat \"*\" (downcase name-of-mode) \"*\")'.") ;;;###autoload (defvar compilation-finish-functions nil @@ -721,8 +721,9 @@ This only affects platforms that support asynchronous processes (see Then every error line will have a debug text property with the matcher that fit this line and the match data. Use `describe-text-properties'.") -(defvar compilation-exit-message-function nil "\ -If non-nil, called when a compilation process dies to return a status message. +(defvar compilation-exit-message-function + (lambda (_process-status exit-status msg) (cons msg exit-status)) + "If non-nil, called when a compilation process dies to return a status message. This should be a function of three arguments: process status, exit status, and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to write into the compilation buffer, and to put in its mode line.") @@ -1562,19 +1563,22 @@ point on its location in the *compilation* buffer." :version "20.3") -(defun compilation-buffer-name (name-of-mode mode-command name-function) +(defun compilation-buffer-name (name-of-mode _mode-command name-function) "Return the name of a compilation buffer to use. If NAME-FUNCTION is non-nil, call it with one argument NAME-OF-MODE to determine the buffer name. Likewise if `compilation-buffer-name-function' is non-nil. -If current buffer has the major mode MODE-COMMAND, +If current buffer has the NAME-OF-MODE major mode, return the name of the current buffer, so that it gets reused. Otherwise, construct a buffer name from NAME-OF-MODE." - (cond (name-function - (funcall name-function name-of-mode)) - (compilation-buffer-name-function - (funcall compilation-buffer-name-function name-of-mode)) - ((eq mode-command major-mode) + (funcall (or name-function + compilation-buffer-name-function + #'compilation--default-buffer-name) + name-of-mode)) + +(defun compilation--default-buffer-name (name-of-mode) + (cond ((or (eq major-mode (intern-soft name-of-mode)) + (eq major-mode (intern-soft (concat name-of-mode "-mode")))) (buffer-name)) (t (concat "*" (downcase name-of-mode) "*")))) @@ -2778,7 +2782,8 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." ;; If compilation-parse-errors-filename-function is ;; defined, use it to process the filename. The result might be a ;; buffer. - (when compilation-parse-errors-filename-function + (unless (memq compilation-parse-errors-filename-function + '(nil identity)) (save-match-data (setq filename (funcall compilation-parse-errors-filename-function commit 3062f81dbf6d815110ad17d5cd19469767e53e5c Author: Stefan Monnier Date: Wed Apr 3 10:58:36 2019 -0400 * lisp/progmodes/compile.el: Allow 'line' functions in error-regexp-alist (compilation-error-properties): Allow 'line' and 'end-line' to be functions, like 'col' and 'end-col'. (compilation-error-regexp-alist): Document this. (compilation-parse-errors): Drop support for old undocumented feature where 'line' was a function of 2 arguments. (compilation--compat-error-properties): Delete function. diff --git a/etc/NEWS b/etc/NEWS index 2bf2b4972a..26c761ae01 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -385,6 +385,10 @@ current and the previous or the next line, as before. * Changes in Specialized Modes and Packages in Emacs 27.1 +** compile.el +--- +*** In compilation-error-regexp-alist, 'line' (and 'end-line') can be functions + ** cl-lib +++ *** cl-defstruct has a new :noinline argument to prevent inlining its functions @@ -1272,6 +1276,9 @@ documentation of the new mode and its commands. * Incompatible Lisp Changes in Emacs 27.1 +** In compilation-error-regexp-alist the old undocumented feature where 'line' +could be a function of 2 arguments has been dropped. + ** 'define-fringe-bitmap' is always defined, even when Emacs is built without any GUI support. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 3650b05607..4018cf7022 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -558,7 +558,11 @@ of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) meaning a range of columns starting on LINE and ending on END-LINE, if that matched. -TYPE is 2 or nil for a real error or 1 for warning or 0 for info. +LINE, END-LINE, COL, and END-COL can also be functions of no argument +that return the corresponding line or column number. They can assume REGEXP +has just been matched, and should correspondingly preserve this match data. + +f/usr/shaTYPE is 2 or nil for a real error or 1 for warning or 0 for info. TYPE can also be of the form (WARNING . INFO). In that case this will be equivalent to 1 if the WARNING'th subexpression matched or else equivalent to 0 if the INFO'th subexpression matched. @@ -1105,23 +1109,27 @@ POS and RES.") (setq file '("*unknown*"))))) ;; All of these fields are optional, get them only if we have an index, and ;; it matched some part of the message. - (and line - (setq line (match-string-no-properties line)) - (setq line (string-to-number line))) - (and end-line - (setq end-line (match-string-no-properties end-line)) - (setq end-line (string-to-number end-line))) - (if col - (if (functionp col) - (setq col (funcall col)) - (and - (setq col (match-string-no-properties col)) - (setq col (string-to-number col))))) - (if (and end-col (functionp end-col)) - (setq end-col (funcall end-col)) - (if (and end-col (setq end-col (match-string-no-properties end-col))) - (setq end-col (- (string-to-number end-col) -1)) - (if end-line (setq end-col -1)))) + (setq line + (if (functionp line) (funcall line) + (and line + (setq line (match-string-no-properties line)) + (string-to-number line)))) + (setq end-line + (if (functionp end-line) (funcall end-line) + (and end-line + (setq end-line (match-string-no-properties end-line)) + (string-to-number end-line)))) + (setq col + (if (functionp col) (funcall col) + (and col + (setq col (match-string-no-properties col)) + (string-to-number col)))) + (setq end-col + (or (if (functionp end-col) (funcall end-col) + (and end-col + (setq end-col (match-string-no-properties end-col)) + (- (string-to-number end-col) -1))) + (and end-line -1))) (if (consp type) ; not a static type, check what it is. (setq type (or (and (car type) (match-end (car type)) 1) (and (cdr type) (match-end (cdr type)) 0) @@ -1222,12 +1230,12 @@ FMTS is a list of format specs for transforming the file name. (setq loc (compilation-assq line (compilation--file-struct->loc-tree file-struct))) (setq end-loc - (if end-line + (if end-line (compilation-assq end-col (compilation-assq end-line (compilation--file-struct->loc-tree file-struct))) - (if end-col ; use same line element + (if end-col ; use same line element (compilation-assq end-col loc)))) (setq loc (compilation-assq col loc)) ;; If they are new, make the loc(s) reference the file they point to. @@ -1370,92 +1378,70 @@ to `compilation-error-regexp-alist' if RULES is nil." (if (consp line) (setq end-line (cdr line) line (car line))) (if (consp col) (setq end-col (cdr col) col (car col))) - (if (functionp line) - ;; The old compile.el had here an undocumented hook that - ;; allowed `line' to be a function that computed the actual - ;; error location. Let's do our best. - (progn - (goto-char start) - (while (re-search-forward pat end t) - (save-match-data - (when compilation-debug - (font-lock-append-text-property - (match-beginning 0) (match-end 0) - 'compilation-debug (vector 'functionp item))) - (add-text-properties - (match-beginning 0) (match-end 0) - (compilation--compat-error-properties - (funcall line (cons (match-string file) - (cons default-directory - (nthcdr 4 item))) - (if col (match-string col)))))) - (compilation--put-prop - file 'font-lock-face compilation-error-face))) + (unless (or (null (nth 5 item)) (integerp (nth 5 item))) + (error "HYPERLINK should be an integer: %s" (nth 5 item))) - (unless (or (null (nth 5 item)) (integerp (nth 5 item))) - (error "HYPERLINK should be an integer: %s" (nth 5 item))) + (goto-char start) + (while (re-search-forward pat end t) + (when (setq props (compilation-error-properties + file line end-line col end-col (or type 2) fmt)) - (goto-char start) - (while (re-search-forward pat end t) - (when (setq props (compilation-error-properties - file line end-line col end-col (or type 2) fmt)) - - (when (integerp file) - (let ((this-type (if (consp type) - (compilation-type type) - (or type 2)))) - (compilation--note-type this-type) - - (compilation--put-prop - file 'font-lock-face - (symbol-value (aref [compilation-info-face - compilation-warning-face - compilation-error-face] - this-type))))) - - (compilation--put-prop - line 'font-lock-face compilation-line-face) - (compilation--put-prop - end-line 'font-lock-face compilation-line-face) - - (compilation--put-prop - col 'font-lock-face compilation-column-face) - (compilation--put-prop - end-col 'font-lock-face compilation-column-face) - - ;; Obey HIGHLIGHT. - (dolist (extra-item (nthcdr 6 item)) - (let ((mn (pop extra-item))) - (when (match-beginning mn) - (let ((face (eval (car extra-item)))) - (cond - ((null face)) - ((or (symbolp face) (stringp face)) - (put-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face face)) - ((and (listp face) - (eq (car face) 'face) - (or (symbolp (cadr face)) - (stringp (cadr face)))) - (compilation--put-prop mn 'font-lock-face (cadr face)) - (add-text-properties - (match-beginning mn) (match-end mn) - (nthcdr 2 face))) - (t - (error "Don't know how to handle face %S" - face))))))) - (let ((mn (or (nth 5 item) 0))) - (when compilation-debug - (font-lock-append-text-property - (match-beginning 0) (match-end 0) - 'compilation-debug (vector 'std item props))) - (add-text-properties - (match-beginning mn) (match-end mn) - (cddr props)) + (when (integerp file) + (let ((this-type (if (consp type) + (compilation-type type) + (or type 2)))) + (compilation--note-type this-type) + + (compilation--put-prop + file 'font-lock-face + (symbol-value (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + this-type))))) + + (compilation--put-prop + line 'font-lock-face compilation-line-face) + (compilation--put-prop + end-line 'font-lock-face compilation-line-face) + + (compilation--put-prop + col 'font-lock-face compilation-column-face) + (compilation--put-prop + end-col 'font-lock-face compilation-column-face) + + ;; Obey HIGHLIGHT. + (dolist (extra-item (nthcdr 6 item)) + (let ((mn (pop extra-item))) + (when (match-beginning mn) + (let ((face (eval (car extra-item)))) + (cond + ((null face)) + ((or (symbolp face) (stringp face)) + (put-text-property + (match-beginning mn) (match-end mn) + 'font-lock-face face)) + ((and (listp face) + (eq (car face) 'face) + (or (symbolp (cadr face)) + (stringp (cadr face)))) + (compilation--put-prop mn 'font-lock-face (cadr face)) + (add-text-properties + (match-beginning mn) (match-end mn) + (nthcdr 2 face))) + (t + (error "Don't know how to handle face %S" + face))))))) + (let ((mn (or (nth 5 item) 0))) + (when compilation-debug (font-lock-append-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face (cadr props))))))))) + (match-beginning 0) (match-end 0) + 'compilation-debug (vector 'std item props))) + (add-text-properties + (match-beginning mn) (match-end mn) + (cddr props)) + (font-lock-append-text-property + (match-beginning mn) (match-end mn) + 'font-lock-face (cadr props)))))))) (defvar compilation--parsed -1) (make-variable-buffer-local 'compilation--parsed) @@ -2837,29 +2823,6 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." (defvar compilation-error-list nil) (defvar compilation-old-error-list nil) -(defun compilation--compat-error-properties (err) - "Map old-style error ERR to new-style message." - ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or - ;; (MARKER . MARKER). - (let ((dst (cdr err))) - (if (markerp dst) - `(compilation-message ,(compilation--make-message - (cons nil (compilation--make-cdrloc - nil nil dst)) - 2 nil) - help-echo "mouse-2: visit the source location" - keymap compilation-button-map - mouse-face highlight) - ;; Too difficult to do it by hand: dispatch to the normal code. - (let* ((file (pop dst)) - (line (pop dst)) - (col (pop dst)) - (filename (pop file)) - (dirname (pop file)) - (fmt (pop file))) - (compilation-internal-error-properties - (cons filename dirname) line nil col nil 2 fmt))))) - (defun compilation--compat-parse-errors (limit) (when compilation-parse-errors-function ;; FIXME: We should remove the rest of the compilation keywords