From 2bcf0f097cd6841af5844d3a2a9d670ba4daea99 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 3 Apr 2019 20:41:47 +0300 Subject: [PATCH 001/121] 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. --- src/pdumper.c | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index 7fabfa771ce..b19f206d1bd 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; } From ce9490cb314694b95847ac647b35f1319ba80fde Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 3 Apr 2019 15:20:50 -0400 Subject: [PATCH 002/121] * test/lisp/progmodes/flymake-tests.el (different-diagnostic-types): Expect failure on hydra.nixos. --- test/lisp/progmodes/flymake-tests.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index 629cdf9a137..732193476dd 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 From 8147d3c27cbf29e18dbdd6bad21cd17bc880a8d3 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 3 Apr 2019 21:36:40 +0200 Subject: [PATCH 003/121] 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. --- lisp/net/tramp-adb.el | 64 ++++++++++---------- lisp/net/tramp-sh.el | 16 +---- lisp/net/tramp.el | 13 +++++ test/lisp/net/tramp-tests.el | 110 +++++++++++++++++++---------------- 4 files changed, 110 insertions(+), 93 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 68960426b68..db9acbfc631 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 edd9af489e2..7d903c5769c 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 7206d8eb8a6..0fc2d33d222 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 1c7198ce560..1ee11f0d38a 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 From 64925714ef6b4d7485e5aee7a8ac063c20c07bc5 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Mon, 25 Mar 2019 10:38:39 -0300 Subject: [PATCH 004/121] Fix repeated 'custom-add-option' in esh-mode.el (Bug#34993) * lisp/eshell/esh-mode.el: Call 'custom-add-option' with the right argument. --- lisp/eshell/esh-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 30298763a53..0a160b9ab37 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." From 5e55b1b82952a03b704c464e8086d3c41e993a46 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Sat, 23 Mar 2019 11:38:14 -0300 Subject: [PATCH 005/121] 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 ...). --- lisp/eshell/eshell.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 45168007565..c7ed7103e40 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 From 18c02f7e078ae574d03ec67939c4755ce3554fb2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 4 Apr 2019 13:41:53 +0200 Subject: [PATCH 006/121] * test/lisp/net/tramp-tests.el (tramp-test43-asynchronous-requests): Make it fit for tramp-adb. Apply better check in process filter. --- test/lisp/net/tramp-tests.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1ee11f0d38a..96e4438ec11 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3923,6 +3923,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + ;; `make-process' supports file name handlers since Emacs 27. (skip-unless (tramp--test-emacs27-p)) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) @@ -5362,20 +5363,14 @@ process sentinels. They shall not disturb each other." ;; we mark it as unstable. :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-p)) - ;; This test is sensible wrt to other running tests. Let it work - ;; only if it is the only selected test. - ;; FIXME: There must be a better solution. - (skip-unless - (= 1 (length - (ert-select-tests (ert--stats-selector ert--current-run-stats) t)))) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) (with-timeout (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) (define-key special-event-map [sigusr1] #'tramp--test-timeout-handler) (let* (;; For the watchdog. (default-directory (expand-file-name temporary-file-directory)) - (shell-file-name "/bin/sh") + (shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")) (watchdog (start-process-shell-command "*watchdog*" nil @@ -5475,7 +5470,7 @@ process sentinels. They shall not disturb each other." "Process filter %s %s %s" proc string (current-time-string)) (with-current-buffer (process-buffer proc) (insert string)) - (unless (zerop (length string)) + (when (< (process-get proc 'bar) 2) (dired-uncache (process-get proc 'foo)) (should (file-attributes (process-get proc 'foo)))))) ;; Add process sentinel. It shall not perform remote @@ -5528,7 +5523,12 @@ process sentinels. They shall not disturb each other." (dolist (buf buffers) (with-current-buffer buf (should - (string-equal (format "%s\n%s\n" buf buf) (buffer-string))))) + (string-equal + ;; tramp-adb.el echoes, so we must add the three strings. + (if (tramp--test-adb-p) + (format "%s\n%s\n%s\n%s\n%s\n" buf buf buf buf buf) + (format "%s\n%s\n" buf buf)) + (buffer-string))))) (should-not (directory-files tmp-name nil directory-files-no-dot-files-regexp))) @@ -5729,8 +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 Bug#16928 in `tramp-test43-asynchronous-requests'. -;; * Fix `tramp-test44-threads'. +;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. Looks +;; like it is resolved now. Remove `:unstable' tag? (provide 'tramp-tests) ;;; tramp-tests.el ends here From 9e79f199ffad18a58c8031d347e8cfb297e12407 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Thu, 4 Apr 2019 11:31:43 -0600 Subject: [PATCH 007/121] ; * src/fontset.c (set-fontset-font): Use uppercase arg in docstring --- src/fontset.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fontset.c b/src/fontset.c index 8e0c5746fe7..34e0c0d4820 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1447,7 +1447,7 @@ or t for the default fontset. TARGET may be a single character to use FONT-SPEC for. -Target may be a cons (FROM . TO), where FROM and TO are characters. +TARGET may be a cons (FROM . TO), where FROM and TO are characters. In that case, use FONT-SPEC for all the characters in the range between FROM and TO (inclusive). From 81f64da220b7a8b46f64212724cb2be6c99a0cac Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 4 Apr 2019 13:46:30 -0400 Subject: [PATCH 008/121] * lisp/desktop.el (desktop--v2s): Add case for defstructs (bug#35131) --- lisp/desktop.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/lisp/desktop.el b/lisp/desktop.el index acabde5eb2f..97c057e2013 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -856,6 +856,19 @@ QUOTE may be `may' (value may be quoted), `',(cdr el) (cdr el))) pass1))) (cons 'may `[,@(mapcar #'cdr pass1)])))) + ((and (recordp value) (symbolp (aref value 0))) + (let* ((pass1 (let ((res ())) + (dotimes (i (length value)) + (push (desktop--v2s (aref value i)) res)) + (nreverse res))) + (special (assq nil pass1))) + (if special + (cons nil `(record + ,@(mapcar (lambda (el) + (if (eq (car el) 'must) + `',(cdr el) (cdr el))) + pass1))) + (cons 'may (apply #'record (mapcar #'cdr pass1)))))) ((consp value) (let ((p value) newlist From d63aa2f3e5009e0e8ec83fecc4f0bbe2866e5a59 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 4 Apr 2019 16:27:29 -0400 Subject: [PATCH 009/121] * lisp/progmodes/compile.el (compilation-error-regexp-alist): Typo MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reported by Kévin Le Gouguec --- lisp/progmodes/compile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 5bfb0bf9018..6d5775209c0 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -562,7 +562,7 @@ 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 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. From 690c678fb6c1fb5b2f828f9bb90782bd0b01c399 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 4 Apr 2019 23:37:08 +0100 Subject: [PATCH 010/121] Fix comment-empty-lines docstring (bug#35152) * lisp/newcomment.el (comment-empty-lines): Consistently use US commas in docstring. Fix indentation of and typo in custom :type. --- lisp/newcomment.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index bb371c5d7ab..9d919ccbbea 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -327,11 +327,11 @@ behavior for explicit filling, you might as well use \\[newline-and-indent]." (defcustom comment-empty-lines nil "If nil, `comment-region' does not comment out empty lines. If t, it always comments out empty lines. -If `eol' it only comments out empty lines if comments are -terminated by the end of line (i.e. `comment-end' is empty)." +If `eol', it only comments out empty lines if comments are +terminated by the end of line (i.e., `comment-end' is empty)." :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "EOl-terminated" eol)) + (const :tag "Always" t) + (const :tag "EOL-terminated" eol)) :group 'comment) ;;;; From 905f6195191a518b7bb2dbdf6eacae41d31fc54e Mon Sep 17 00:00:00 2001 From: Troy Hinckley Date: Wed, 16 Jan 2019 14:47:07 -0800 Subject: [PATCH 011/121] Don't check comp-buffer-name-function in derived mode (Bug#34956) * lisp/progmodes/compile.el (define-compilation-mode): Remove 'compilation-buffer-name-function' from the list of overridden variables to ensure that it is not mistaken for a variable that can be major mode specific. 'compilation-buffer-name-function' is used before the major mode is loaded, therefore overriding it here is ineffectual. Also, the function 'compilation-start' takes an optional argument name-function, so there is already a mechanism to override it. --- lisp/progmodes/compile.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 6d5775209c0..1a0d9bdbb70 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2056,8 +2056,7 @@ by replacing the first word, e.g., `compilation-scroll-output' from (if (boundp 'byte-compile-bound-variables) (memq (cdr v) byte-compile-bound-variables))) `(set (make-local-variable ',(car v)) ,(cdr v)))) - '(compilation-buffer-name-function - compilation-directory-matcher + '(compilation-directory-matcher compilation-error compilation-error-regexp-alist compilation-error-regexp-alist-alist From a68c96863289d5d8ccfc2f775d0018a2721c5e53 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 4 Apr 2019 20:41:02 -0400 Subject: [PATCH 012/121] ; Fix copyright years --- lisp/leim/quail/sami.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/leim/quail/sami.el b/lisp/leim/quail/sami.el index d4cf4ec96e8..7cfd0b7348c 100644 --- a/lisp/leim/quail/sami.el +++ b/lisp/leim/quail/sami.el @@ -1,6 +1,6 @@ ;;; sami.el --- Quail package for inputting Sámi -*-coding: utf-8;-*- -;; Copyright (C) 1998, 2001-2019 Free Software Foundation, Inc. +;; Copyright (C) 2019 Free Software Foundation, Inc. ;; Author: Wojciech S. Gac ;; Maintainer: Wojciech S. Gac > From 9da8f22de09c73e9557161fd7bb189138ce1fe2f Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Fri, 5 Apr 2019 04:25:06 +0000 Subject: [PATCH 013/121] Make `move article' work again (bug#33653) * lisp/gnus/gnus-sum.el (gnus-summary-move-article): Back to while loop m dolist that blocks nov and active from saving (bug#33653). --- lisp/gnus/gnus-sum.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index f5853a24305..21f0e5951cc 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9979,7 +9979,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref to-groups + art-group to-method new-xref article to-groups articles-to-update-marks encoded) (unless (assq action names) (error "Unknown action %s" action)) @@ -10029,7 +10029,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) - (dolist (article articles) + (while articles + (setq article (pop articles)) ;; Set any marks that may have changed in the summary buffer. (when gnus-preserve-marks (gnus-summary-push-marks-to-backend article)) From 3187efe713938ad41b676de9dbd92f986d46aa05 Mon Sep 17 00:00:00 2001 From: Konstantin Kharlamov Date: Tue, 2 Apr 2019 03:23:27 +0300 Subject: [PATCH 014/121] Minor cleanup in gtkutil.c * src/gtkutil.c (x_wm_set_size_hint): Remove variables that are always zero, and simplify all expressions which used them. (Bug#35062) --- src/gtkutil.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/gtkutil.c b/src/gtkutil.c index 4bd73b1a6d1..b130692c87a 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1401,7 +1401,6 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) GdkGeometry size_hints; gint hint_flags = 0; int base_width, base_height; - int min_rows = 0, min_cols = 0; int win_gravity = f->win_gravity; Lisp_Object fs_state, frame; int scale = xg_get_scale (f); @@ -1450,13 +1449,10 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 1) + FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f); - if (min_cols > 0) --min_cols; /* We used one col in base_width = ... 1); */ - if (min_rows > 0) --min_rows; /* We used one row in base_height = ... 1); */ - size_hints.base_width = base_width; size_hints.base_height = base_height; - size_hints.min_width = base_width + min_cols * FRAME_COLUMN_WIDTH (f); - size_hints.min_height = base_height + min_rows * FRAME_LINE_HEIGHT (f); + size_hints.min_width = base_width; + size_hints.min_height = base_height; /* These currently have a one to one mapping with the X values, but I don't think we should rely on that. */ From 051533c6fa63ee10e58e83823ba962a005ba68f9 Mon Sep 17 00:00:00 2001 From: Konstantin Kharlamov Date: Tue, 2 Apr 2019 23:49:58 +0300 Subject: [PATCH 015/121] Minor cleanup in widget.c * src/widget.c (update_wm_hints): Remove variables that are always zero, and simplify all expressions which used them. (Bug#35062) --- src/widget.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/widget.c b/src/widget.c index c695bd5f305..508974dd46f 100644 --- a/src/widget.c +++ b/src/widget.c @@ -297,7 +297,6 @@ update_wm_hints (EmacsFrame ew) int char_height; int base_width; int base_height; - int min_rows = 0, min_cols = 0; /* This happens when the frame is just created. */ if (! wmshell) return; @@ -323,8 +322,8 @@ update_wm_hints (EmacsFrame ew) XtNbaseHeight, (XtArgVal) base_height, XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw), XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch), - XtNminWidth, (XtArgVal) (base_width + min_cols * cw), - XtNminHeight, (XtArgVal) (base_height + min_rows * ch), + XtNminWidth, (XtArgVal) base_width, + XtNminHeight, (XtArgVal) base_height, NULL); } From f2d22273599f96a731e23b2f6d7571af8bb7bb3f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 5 Apr 2019 13:27:06 +0200 Subject: [PATCH 016/121] Adapt tramp-tests.el * test/lisp/net/tramp-tests.el (tramp-test30-make-process): Instrument test. Adapt check string. (tramp-test34-explicit-shell-file-name) (tramp-test43-asynchronous-requests): Skip tests for tramp-adb with older Emacsen. --- test/lisp/net/tramp-tests.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 96e4438ec11..5a9541db8fb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3926,6 +3926,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; `make-process' supports file name handlers since Emacs 27. (skip-unless (tramp--test-emacs27-p)) + (tramp--test-instrument-test-case 0 (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)) @@ -4045,11 +4046,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (while (= (point-min) (point-max)) (while (accept-process-output proc 0 nil t)))) (should - (string-equal (buffer-string) "cat: /: Is a directory\n")))) + (string-match "^cat:.* Is a directory" (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc)) - (ignore-errors (kill-buffer stderr)))))))) + (ignore-errors (kill-buffer stderr))))))))) (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." @@ -4365,7 +4366,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check that connection-local `explicit-shell-file-name' is set." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for + ;; remote processes in Emacs. That doesn't work for tramp-adb.el. + (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) + (tramp--test-sh-p))) ;; Since Emacs 26.1. (skip-unless (and (fboundp 'connection-local-set-profile-variables) (fboundp 'connection-local-set-profiles))) @@ -5363,7 +5367,10 @@ process sentinels. They shall not disturb each other." ;; we mark it as unstable. :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) - (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for + ;; remote processes in Emacs. That doesn't work for tramp-adb.el. + (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) + (tramp--test-sh-p))) (with-timeout (tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler)) @@ -5731,6 +5738,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. Looks ;; like it is resolved now. Remove `:unstable' tag? +;; * Implement `tramp-test31-interrupt-process' for `adb'. (provide 'tramp-tests) ;;; tramp-tests.el ends here From 652f5d4922f760e527d5a299c14c122de16844d1 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 5 Apr 2019 17:03:04 -0700 Subject: [PATCH 017/121] * doc/emacs/emacs.texi (Acknowledgments): Remove duplicate. --- doc/emacs/emacs.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 7edc1a5fae1..58ec3730299 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -1484,7 +1484,7 @@ Stevens, Andy Stewart, Jonathan Stigelman, Martin Stjernholm, Kim F. Storm, Steve Strassmann, Christopher Suckling, Olaf Sylvester, Naoto Takahashi, Steven Tamm, Jan Tatarik, Luc Teirlinck, Jean-Philippe Theberge, Jens T. Berger Thielemann, Spencer Thomas, Jim Thompson, Toru Tomabechi, -David O'Toole, Markus Triska, Tom Tromey, Enami Tsugutomo, Eli +David O'Toole, Markus Triska, Tom Tromey, Eli Tziperman, Daiki Ueno, Masanobu Umeda, Rajesh Vaidheeswarran, Neil W. Van Dyke, Didier Verna, Joakim Verona, Ulrik Vieth, Geoffrey Voelker, Johan Vromans, Inge Wallin, John Paul Wallington, Colin From 01dc2da75ba11f8ddb1ac1802a8c5a7f0caea975 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Krzywkowski?= Date: Fri, 5 Apr 2019 20:33:07 -0400 Subject: [PATCH 018/121] Small elide-head.el update * lisp/elide-head.el (elide-head-headers-to-hide): Also match https for GPL. (Bug#34919) --- lisp/elide-head.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 82d08190a63..c1678c003db 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -52,7 +52,7 @@ (defcustom elide-head-headers-to-hide '(("is free software[:;] you can redistribute it" . ; GNU boilerplate "\\(Boston, MA 0211\\(1-1307\\|0-1301\\), USA\\|\ -If not, see \\)\\.") +If not, see \\)\\.") ("The Regents of the University of California\\. All rights reserved\\." . "SUCH DAMAGE\\.") ; BSD ("Permission is hereby granted, free of charge" . ; X11 From 10cd65878c741d2a22a1f2c36c54fcad4e516f72 Mon Sep 17 00:00:00 2001 From: Alex Branham Date: Mon, 25 Mar 2019 20:49:01 -0500 Subject: [PATCH 019/121] Update documentation for indent-relative functions * lisp/indent.el (indent-relative): Document what happens when there is no previous nonblank line. * doc/lispref/text.texi (Relative Indent): Document indent-relative-first-indent-point instead of obsolete indent-relative-maybe. Fix documentation of which argument from 'indent-relative' is used. Bug#34858 --- doc/lispref/text.texi | 4 ++-- lisp/indent.el | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 86f9fa0e5f5..1ef836b8f94 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -2577,11 +2577,11 @@ The quick brown fox jum @point{}ped. @end example @end deffn -@deffn Command indent-relative-maybe +@deffn Command indent-relative-first-indent-point @comment !!SourceFile indent.el This command indents the current line like the previous nonblank line, by calling @code{indent-relative} with @code{t} as the -@var{unindented-ok} argument. The return value is unpredictable. +@var{first-only} argument. The return value is unpredictable. If the previous nonblank line has no indent points beyond the current column, this command does nothing. diff --git a/lisp/indent.el b/lisp/indent.el index f3d3158faa0..bf87d6af760 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -600,8 +600,9 @@ considered. If the previous nonblank line has no indent points beyond the column point starts at, then `tab-to-tab-stop' is done, if both -FIRST-ONLY and UNINDENTED-OK are nil, otherwise nothing is done -in this case. +FIRST-ONLY and UNINDENTED-OK are nil, otherwise nothing is done. +If there isn't a previous nonblank line and UNINDENTED-OK is nil, +call `tab-to-tab-stop'. See also `indent-relative-first-indent-point'." (interactive "P") From a8cffcf27f4d4f7e35462e2ccb011d231f1a61cc Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Fri, 5 Apr 2019 17:40:12 -0300 Subject: [PATCH 020/121] Fix typo in a doc string * lisp/autorevert.el (global-auto-revert-mode): Fix a typo. (Bug#35165) --- lisp/autorevert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 242344fe9d1..58c5dba3160 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -472,7 +472,7 @@ If `global-auto-revert-non-file-buffers' is non-nil, this mode may also revert some non-file buffers, as described in the documentation of that variable. It ignores buffers with modes matching `global-auto-revert-ignore-modes', and buffers with a -non-nil vale of `global-auto-revert-ignore-buffer'. +non-nil value of `global-auto-revert-ignore-buffer'. When a buffer is reverted, a message is generated. This can be suppressed by setting `auto-revert-verbose' to nil. From 6dc42c562c5ae3ca5a7d7eb4223cd82554e3cfad Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Apr 2019 10:16:16 +0300 Subject: [PATCH 021/121] Improve commentary in frame.el * lisp/frame.el: Improve commentary for display-* functions. (Bug#35058) --- lisp/frame.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/frame.el b/lisp/frame.el index 9438b4a72ed..a0e62e1d69d 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1691,6 +1691,14 @@ for FRAME." ;;;; Frame/display capabilities. +;; These functions should make the features they test explicit in +;; their names, so that when capabilities or the corresponding Emacs +;; features change, it will be easy to find all the tests for such +;; capabilities by a simple text search. See more about the history +;; and the intent of these functions in +;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html +;; or in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35058#17. + (declare-function msdos-mouse-p "dosfns.c") (defun display-mouse-p (&optional display) From 92ce2dd48bd3f31b848f0258ad79af01a7197b44 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Apr 2019 11:04:37 +0300 Subject: [PATCH 022/121] Improve documentation of window parameters * doc/lispref/windows.texi (Cyclic Window Ordering): Describe the effect of the 'other-window' window parameter. (Window Parameters): Improve the descriptions of window parameters. Move the detailed description of the 'quit-restore' window parameter from here... (Quitting Windows): ...to here. (Bug#35063) --- doc/lispref/windows.texi | 93 ++++++++++++++++++++++------------------ 1 file changed, 51 insertions(+), 42 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 7f0fcffaaf1..27940e12c79 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1956,7 +1956,13 @@ The optional argument @var{all-frames} has the same meaning as in @code{next-window}. This function does not select a window that has a non-@code{nil} -@code{no-other-window} window parameter (@pxref{Window Parameters}). +@code{no-other-window} window parameter (@pxref{Window Parameters}), +provided that @code{ignore-window-parameters} is @code{nil}. + +If the @code{other-window} parameter of the selected window is a +function, and @code{ignore-window-parameters} is @code{nil}, that +function will be called with the arguments @var{count} and +@var{all-frames} instead of the normal operation of this function. @end deffn @defun walk-windows fun &optional minibuf all-frames @@ -3903,8 +3909,33 @@ described next to deal with the window and its buffer. This function handles @var{window} and its buffer after quitting. The optional argument @var{window} must be a live window and defaults to the selected one. The function's behavior is determined by the four -elements of the @code{quit-restore} window parameter (@pxref{Window -Parameters}), which is set to @code{nil} afterwards. +elements of the list specified by the @code{quit-restore} window +parameter (@pxref{Window Parameters}), which is set to @code{nil} +afterwards. + +The first element of the @code{quit-restore} parameter is one of the +symbols @code{window}, meaning that the window has been specially +created by @code{display-buffer}; @code{frame}, a separate frame has +been created; @code{same}, the window has only ever displayed this +buffer; or @code{other}, the window showed another buffer before. +@code{frame} and @code{window} affect how the window is quit, while +@code{same} and @code{other} affect the redisplay of buffers +previously shown in this window. + +The second element is either one of the symbols @code{window} or +@code{frame}, or a list whose elements are the buffer shown in the +window before, that buffer's window start and window point positions, +and the window's height at that time. If that buffer is still live +when the window is quit, then the function @code{quit-restore-window} +reuses the window to display the buffer. + +The third element is the window selected at the time the parameter was +created. If @code{quit-restore-window} deletes the window passed to +it as argument, it then tries to reselect this window. + +The fourth element is the buffer whose display caused the creation of +this parameter. @code{quit-restore-window} deletes the specified window +only if it still shows that buffer. The window is deleted entirely if: 1) the first element of the @code{quit-restore} parameter is one of 'window or 'frame, 2) the @@ -5754,8 +5785,8 @@ and heights, if possible. Frames are not resized by this function. @section Window Parameters @cindex window parameters -This section describes how window parameters can be used to associate -additional information with windows. +This section describes the window parameters that can be used to +associate additional information with windows. @defun window-parameter window parameter This function returns @var{window}'s value for @var{parameter}. The @@ -5888,44 +5919,21 @@ parameter is installed and updated by the function @vindex quit-restore@r{, a window parameter} This parameter is installed by the buffer display functions (@pxref{Choosing Window}) and consulted by @code{quit-restore-window} -(@pxref{Quitting Windows}). It contains four elements: +(@pxref{Quitting Windows}). It is a list of four elements, see the +description of @code{quit-restore-window} in @ref{Quitting Windows} +for details. -The first element is one of the symbols @code{window}, meaning that -the window has been specially created by @code{display-buffer}; -@code{frame}, a separate frame has been created; @code{same}, the -window has only ever displayed this buffer; or @code{other}, the -window showed another buffer before. @code{frame} and @code{window} -affect how the window is quit, while @code{same} and @code{other} -affect the redisplay of buffers previously shown in this window. - -The second element is either one of the symbols @code{window} or -@code{frame}, or a list whose elements are the buffer shown in the -window before, that buffer's window start and window point positions, -and the window's height at that time. If that buffer is still live -when the window is quit, then the function @code{quit-restore-window} -reuses the window to display the buffer. - -The third element is the window selected at the time the parameter was -created. If @code{quit-restore-window} deletes the window passed to -it as argument, it then tries to reselect this window. - -The fourth element is the buffer whose display caused the creation of -this parameter. @code{quit-restore-window} deletes the specified window -only if it still shows that buffer. - -See the description of @code{quit-restore-window} in @ref{Quitting -Windows} for details. - -@item window-side window-slot +@item window-side +@itemx window-slot @vindex window-side@r{, a window parameter} @vindex window-slot@r{, a window parameter} -These parameters are used for implementing side windows (@pxref{Side -Windows}). +These parameters are used internally for implementing side windows +(@pxref{Side Windows}). @item window-atom @vindex window-atom@r{, a window parameter} -This parameter is used for implementing atomic windows, see @ref{Atomic -Windows}. +This parameter is used internally for implementing atomic windows, see +@ref{Atomic Windows}. @item mode-line-format @vindex mode-line-format@r{, a window parameter} @@ -5947,11 +5955,12 @@ affected. @item min-margins @vindex min-margins@r{, a window parameter} -The value of this parameter is a cons cell whose @sc{car} and @sc{cdr}, -if non-@code{nil}, specify the minimum values (in columns) for the left -and right margin of this window. When present, Emacs will use these -values instead of the actual margin widths for determining whether a -window can be split or shrunk horizontally. +The value of this parameter is a cons cell whose @sc{car} and +@sc{cdr}, if non-@code{nil}, specify the minimum values (in columns) +for the left and right margin of this window (@pxref{Display Margins}. +When present, Emacs will use these values instead of the actual margin +widths for determining whether a window can be split or shrunk +horizontally. Emacs never auto-adjusts the margins of any window after splitting or resizing it. It is the sole responsibility of any application setting From a30a6c3019ac09ede1cc47671083b2e9ecdbffdf Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Apr 2019 11:22:13 +0300 Subject: [PATCH 023/121] Improve documentation of set-window-start * doc/lispref/windows.texi (Window Start and End): * src/window.c (Fset_window_start): Document that reliable setting of a window start position requires to adjust point to be visible. (Bug#34038) --- doc/lispref/windows.texi | 22 +++++++++++++++------- src/window.c | 7 ++++++- 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 27940e12c79..f4395c12d26 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4625,13 +4625,14 @@ This function sets the display-start position of @var{window} to @var{position} in @var{window}'s buffer. It returns @var{position}. The display routines insist that the position of point be visible when a -buffer is displayed. Normally, they change the display-start position -(that is, scroll the window) whenever necessary to make point visible. -However, if you specify the start position with this function using -@code{nil} for @var{noforce}, it means you want display to start at -@var{position} even if that would put the location of point off the -screen. If this does place point off screen, the display routines move -point to the left margin on the middle line in the window. +buffer is displayed. Normally, they select the display-start position +according to their internal logic (and scroll the window if necessary) +to make point visible. However, if you specify the start position +with this function using @code{nil} for @var{noforce}, it means you +want display to start at @var{position} even if that would put the +location of point off the screen. If this does place point off +screen, the display routines attempt to move point to the left margin +on the middle line in the window. For example, if point @w{is 1} and you set the start of the window @w{to 37}, the start of the next line, point will be above the top @@ -4678,6 +4679,13 @@ it is still 1 when redisplay occurs. Here is an example: @end group @end example +If the attempt to make point visible (i.e., in a fully-visible screen +line) fails, the display routines will disregard the requested +window-start position and compute a new one anyway. Thus, for +reliable results Lisp programs that call this function should always +move point to be inside the window whose display starts at +@var{position}. + If @var{noforce} is non-@code{nil}, and @var{position} would place point off screen at the next redisplay, then redisplay computes a new window-start position that works well with point, and thus @var{position} is not used. diff --git a/src/window.c b/src/window.c index 04183abb7c5..dfac3b5b879 100644 --- a/src/window.c +++ b/src/window.c @@ -1704,7 +1704,12 @@ DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0, doc: /* Make display in WINDOW start at position POS in WINDOW's buffer. WINDOW must be a live window and defaults to the selected one. Return POS. Optional third arg NOFORCE non-nil inhibits next redisplay from -overriding motion of point in order to display at this exact start. */) +overriding motion of point in order to display at this exact start. + +For reliable setting of WINDOW start position, make sure point is +at a position that will be visible when that start is in effect, +otherwise there's a chance POS will be disregarded, e.g., if point +winds up in a partially-visible line. */) (Lisp_Object window, Lisp_Object pos, Lisp_Object noforce) { register struct window *w = decode_live_window (window); From 646d33dbbced04b3454fa5f726309dd96cd089c7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Apr 2019 11:48:36 +0300 Subject: [PATCH 024/121] Fix doc strings of 'vc-version-diff' and 'vc-version-ediff' * lisp/vc/vc.el (vc-version-diff, vc-version-ediff): Describe arguments in the doc strings. (Bug#35019) --- lisp/vc/vc.el | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 326284f4446..353299cbed9 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1814,7 +1814,12 @@ Return t if the buffer had changes, nil otherwise." ;;;###autoload (defun vc-version-diff (_files rev1 rev2) - "Report diffs between revisions of the fileset in the repository history." + "Report diffs between revisions REV1 and REV2 in the repository history. +This compares two revisions of the current fileset. +If REV1 is nil, it defaults to the current revision, i.e. revision +of the last commit. +If REV2 is nil, it defaults to the work tree, i.e. the current +state of each file in the fileset." (interactive (vc-diff-build-argument-list-internal)) ;; All that was just so we could do argument completion! (when (and (not rev1) rev2) @@ -1846,8 +1851,14 @@ saving the buffer." ;;;###autoload (defun vc-version-ediff (files rev1 rev2) - "Show differences between revisions of the fileset in the -repository history using ediff." + "Show differences between REV1 and REV2 of FILES using ediff. +This compares two revisions of the files in FILES. Currently, +only a single file's revisions can be compared, i.e. FILES can +specify only one file name. +If REV1 is nil, it defaults to the current revision, i.e. revision +of the last commit. +If REV2 is nil, it defaults to the work tree, i.e. the current +state of each file in FILES." (interactive (vc-diff-build-argument-list-internal)) ;; All that was just so we could do argument completion! (when (and (not rev1) rev2) From bcc6468b39916de6a3756c98e744ed5d0534eb40 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 6 Apr 2019 11:36:34 +0200 Subject: [PATCH 025/121] Fix Bug#34847 * lisp/autorevert.el (auto-revert-remove-current-buffer): Add optional argument BUFFER. (auto-revert-notify-rm-watch): Remove local hook. (auto-revert-buffers): Check `buffer-live-p' in time. (Bug#34847) --- lisp/autorevert.el | 52 ++++++++++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index bc7c616ecb7..e6dfafca2a5 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -343,10 +343,11 @@ This has been reported by a file notification event.") ;; Functions: -(defun auto-revert-remove-current-buffer () - "Remove dead buffer from `auto-revert-buffer-list'." +(defun auto-revert-remove-current-buffer (&optional buffer) + "Remove BUFFER from `auto-revert-buffer-list'. +BUFFER defaults to `current-buffer'." (setq auto-revert-buffer-list - (delq (current-buffer) auto-revert-buffer-list))) + (delq (or buffer (current-buffer)) auto-revert-buffer-list))) ;;;###autoload (define-minor-mode auto-revert-mode @@ -509,7 +510,7 @@ will use an up-to-date value of `auto-revert-interval'" (ignore-errors (file-notify-rm-watch auto-revert-notify-watch-descriptor))))) auto-revert-notify-watch-descriptor-hash-list) - (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch)) + (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t)) (setq auto-revert-notify-watch-descriptor nil auto-revert-notify-modified-p nil)) @@ -772,10 +773,12 @@ the timer when no buffers need to be checked." (setq bufs (delq nil (mapcar (lambda (buf) - (with-current-buffer buf - (and (or (not (file-remote-p default-directory)) - (file-remote-p default-directory nil t)) - buf))) + (and (buffer-live-p buf) + (with-current-buffer buf + (and + (or (not (file-remote-p default-directory)) + (file-remote-p default-directory nil t)) + buf)))) bufs))) ;; Partition `bufs' into two halves depending on whether or not ;; the buffers are in `auto-revert-remaining-buffers'. The two @@ -792,24 +795,23 @@ the timer when no buffers need to be checked." (not (and auto-revert-stop-on-user-input (input-pending-p)))) (let ((buf (car bufs))) - (with-current-buffer buf - (if (buffer-live-p buf) - (progn - ;; Test if someone has turned off Auto-Revert Mode - ;; in a non-standard way, for example by changing - ;; major mode. - (if (and (not auto-revert-mode) - (not auto-revert-tail-mode) - (memq buf auto-revert-buffer-list)) - (auto-revert-remove-current-buffer)) - (when (auto-revert-active-p) - ;; Enable file notification. - (when (and auto-revert-use-notify - (not auto-revert-notify-watch-descriptor)) - (auto-revert-notify-add-watch)) - (auto-revert-handler))) + (if (not (buffer-live-p buf)) ;; Remove dead buffer from `auto-revert-buffer-list'. - (auto-revert-remove-current-buffer)))) + (auto-revert-remove-current-buffer buf) + (with-current-buffer buf + ;; Test if someone has turned off Auto-Revert Mode + ;; in a non-standard way, for example by changing + ;; major mode. + (if (and (not auto-revert-mode) + (not auto-revert-tail-mode) + (memq buf auto-revert-buffer-list)) + (auto-revert-remove-current-buffer)) + (when (auto-revert-active-p) + ;; Enable file notification. + (when (and auto-revert-use-notify + (not auto-revert-notify-watch-descriptor)) + (auto-revert-notify-add-watch)) + (auto-revert-handler))))) (setq bufs (cdr bufs))) (setq auto-revert-remaining-buffers bufs) ;; Check if we should cancel the timer. From 47aae7cfe17c4a803c703ba237cf1c62d246766d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Apr 2019 16:16:32 +0300 Subject: [PATCH 026/121] ; * src/w32fns.c (Fw32_read_registry): Doc fix. --- src/w32fns.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/w32fns.c b/src/w32fns.c index 25900c54c88..af82b463059 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10099,6 +10099,8 @@ It can also be nil, which means try `HKCU', and if that fails, try `HKLM'. KEY and NAME must be strings, and NAME must not include slashes. KEY can use either forward- or back-slashes. +To access the default value of KEY (if it is defined), use NAME +that is an empty string. If the the named KEY or its subkey called NAME don't exist, or cannot be accessed by the current user, the function returns nil. Otherwise, From 7dc0a06959ab5ebda2f2cc4ed31a1b66395e2cf9 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 6 Apr 2019 02:41:16 +0100 Subject: [PATCH 027/121] Don't leave inhibit_buffer_hooks uninitialized * src/buffer.c (Fget_buffer_create): Explicitly initialize inhibit_buffer_hooks. (bug#34847) --- src/buffer.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/buffer.c b/src/buffer.c index c0f7521c9e1..c5d8ee26291 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -588,6 +588,8 @@ even if it is dead. The return value is never nil. */) && strncmp (SSDATA (name), SSDATA (Vcode_conversion_workbuf_name), SBYTES (Vcode_conversion_workbuf_name)) == 0) b->inhibit_buffer_hooks = true; + else + b->inhibit_buffer_hooks = false; bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt); From 91018cec0157f649a0b4b5db7399e683e7089093 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Apr 2019 17:53:30 +0300 Subject: [PATCH 028/121] Encode the FILENAME argument of 'file-locked-p' * src/filelock.c (Ffile_locked_p): Encode the file name, before passing it to system APIs. (Bug#35171) --- src/filelock.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/filelock.c b/src/filelock.c index 5cec1996201..baf87b7f635 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -822,6 +822,7 @@ t if it is locked by you, else a string saying which user has locked it. */) USE_SAFE_ALLOCA; filename = Fexpand_file_name (filename, Qnil); + filename = ENCODE_FILE (filename); MAKE_LOCK_NAME (lfname, filename); From 19919e0f32717638592c9f480ae970c100dfc91e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 6 Apr 2019 12:57:44 -0700 Subject: [PATCH 029/121] * doc/misc/tramp.texi (Remote processes): '.' or ',' must follow xref. --- doc/misc/tramp.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 264a64b26ad..771ff1c08ee 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3010,7 +3010,7 @@ Starting with Emacs 26, you could use connection-local variables for setting different values of @code{explicit-shell-file-name} for different remote hosts. @ifinfo -@xref{Connection Variables, , , emacs} +@xref{Connection Variables, , , emacs}. @end ifinfo @lisp From 7e4d4c069ce78d4bb82ae72f4b52897eab2b128a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 6 Apr 2019 18:44:24 -0400 Subject: [PATCH 030/121] * lisp/subr.el (setq-default): Fix thinko MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reported by Johan Bockgård --- lisp/subr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/subr.el b/lisp/subr.el index 8d51474b0c9..45b39161965 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -138,7 +138,7 @@ This sets each VAR's default value to the corresponding VALUE. The VALUE for the Nth VAR can refer to the new default values of previous VARs. -\(setq-default [VAR VALUE]...)" +\(fn [VAR VALUE]...)" (declare (debug setq)) (let ((exps nil)) (while args From 43f4c7ddd2077b2e786d069bbb9e2de32f23ffb2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 6 Apr 2019 18:54:31 -0400 Subject: [PATCH 031/121] * src/buffer.c (Fget_buffer_create): Apply booleans's eta-reduction --- src/buffer.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/buffer.c b/src/buffer.c index c5d8ee26291..ab477481912 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -584,12 +584,10 @@ even if it is dead. The return value is never nil. */) set_string_intervals (name, NULL); bset_name (b, name); - if (STRINGP (Vcode_conversion_workbuf_name) - && strncmp (SSDATA (name), SSDATA (Vcode_conversion_workbuf_name), - SBYTES (Vcode_conversion_workbuf_name)) == 0) - b->inhibit_buffer_hooks = true; - else - b->inhibit_buffer_hooks = false; + b->inhibit_buffer_hooks + = (STRINGP (Vcode_conversion_workbuf_name) + && strncmp (SSDATA (name), SSDATA (Vcode_conversion_workbuf_name), + SBYTES (Vcode_conversion_workbuf_name)) == 0); bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt); From 08235af38c92e95d8ec9d268916d8910ea50ab2d Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 7 Apr 2019 03:36:47 +0100 Subject: [PATCH 032/121] Distinguish buttons from widgets (bug#34506) * lisp/button.el (button-at): * lisp/wid-edit.el (widget-at): Avoid returning a false positive when looking for a button and finding a widget, or vice versa. * test/lisp/button-tests.el: * test/lisp/wid-edit-tests.el: New files. --- lisp/button.el | 10 ++++++---- lisp/wid-edit.el | 5 +++-- test/lisp/button-tests.el | 40 +++++++++++++++++++++++++++++++++++++ test/lisp/wid-edit-tests.el | 39 ++++++++++++++++++++++++++++++++++++ 4 files changed, 88 insertions(+), 6 deletions(-) create mode 100644 test/lisp/button-tests.el create mode 100644 test/lisp/wid-edit-tests.el diff --git a/lisp/button.el b/lisp/button.el index c46f3d9a52b..921e84dfa68 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -382,10 +382,12 @@ Also see `make-text-button'." If the button at POS is a text property button, the return value is a marker pointing to POS." (let ((button (get-char-property pos 'button))) - (if (or (overlayp button) (null button)) - button - ;; Must be a text-property button; return a marker pointing to it. - (copy-marker pos t)))) + (and button (get-char-property pos 'category) + (if (overlayp button) + button + ;; Must be a text-property button; + ;; return a marker pointing to it. + (copy-marker pos t))))) (defun next-button (pos &optional count-current) "Return the next button after position POS in the current buffer. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 52c0b5b74d2..b9f98cdc4c7 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1163,8 +1163,9 @@ When not inside a field, signal an error." (defun widget-at (&optional pos) "The button or field at POS (default, point)." - (or (get-char-property (or pos (point)) 'button) - (widget-field-at pos))) + (let ((widget (or (get-char-property (or pos (point)) 'button) + (widget-field-at pos)))) + (and (widgetp widget) widget))) ;;;###autoload (defun widget-setup () diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el new file mode 100644 index 00000000000..d54a992ab89 --- /dev/null +++ b/test/lisp/button-tests.el @@ -0,0 +1,40 @@ +;;; button-tests.el --- tests for button.el -*- lexical-binding: t -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) + +(ert-deftest button-at () + "Test `button-at' behavior." + (with-temp-buffer + (should-not (button-at (point))) + (let ((button (insert-text-button "text button")) + (marker (button-at (1- (point))))) + (should (markerp marker)) + (should (= (button-end button) (button-end marker) (point)))) + (let ((button (insert-button "overlay button")) + (overlay (button-at (1- (point))))) + (should (overlayp overlay)) + (should (eq button overlay))) + ;; Buttons and widgets are incompatible (bug#34506). + (widget-create 'link "link widget") + (should-not (button-at (1- (point)))))) + +;;; button-tests.el ends here diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el new file mode 100644 index 00000000000..a4350e715ed --- /dev/null +++ b/test/lisp/wid-edit-tests.el @@ -0,0 +1,39 @@ +;;; wid-edit-tests.el --- tests for wid-edit.el -*- lexical-binding: t -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'wid-edit) + +(ert-deftest widget-at () + "Test `widget-at' behavior." + (with-temp-buffer + (should-not (widget-at)) + (let ((marco (widget-create 'link "link widget")) + (polo (widget-at (1- (point))))) + (should (widgetp polo)) + (should (eq marco polo))) + ;; Buttons and widgets are incompatible (bug#34506). + (insert-text-button "text button") + (should-not (widget-at (1- (point)))) + (insert-button "overlay button") + (should-not (widget-at (1- (point)))))) + +;;; wid-edit-tests.el ends here From 8f6e4798459a881b0a1602a1a0e30f0b73d49d22 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Wed, 3 Apr 2019 13:57:16 -0600 Subject: [PATCH 033/121] Use display-graphic-p and display-multi-frame-p in more cases * lisp/disp-table.el: * lisp/faces.el: * lisp/frame.el: * lisp/info.el (Info-fontify-node): * lisp/window.el (handle-select-window): Use display-graphic-p and display-multi-frame-p instead of explicit memq calls. --- lisp/disp-table.el | 14 +++++++------- lisp/faces.el | 20 +++++++++----------- lisp/frame.el | 19 +++++++++---------- lisp/info.el | 2 +- lisp/window.el | 4 +++- 5 files changed, 29 insertions(+), 30 deletions(-) diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 476c0cb9861..4a597506774 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -175,8 +175,8 @@ in the default way after this call." (defun standard-display-g1 (c sc) "Display character C as character SC in the g1 character set. This function assumes that your terminal uses the SO/SI characters; -it is meaningless for an X frame." - (if (memq window-system '(x w32 ns)) +it is meaningless for a graphical frame." + (if (display-graphic-p) (error "Cannot use string glyphs in a windowing system")) (or standard-display-table (setq standard-display-table (make-display-table))) @@ -186,9 +186,9 @@ it is meaningless for an X frame." ;;;###autoload (defun standard-display-graphic (c gc) "Display character C as character GC in graphics character set. -This function assumes VT100-compatible escapes; it is meaningless for an -X frame." - (if (memq window-system '(x w32 ns)) +This function assumes VT100-compatible escapes; it is meaningless +for a graphical frame." + (if (display-graphic-p) (error "Cannot use string glyphs in a windowing system")) (or standard-display-table (setq standard-display-table (make-display-table))) @@ -276,7 +276,7 @@ in `.emacs'." (progn (standard-display-default (unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255)) - (unless (or (memq window-system '(x w32 ns))) + (unless (display-graphic-p) (and (terminal-coding-system) (set-terminal-coding-system nil)))) @@ -289,7 +289,7 @@ in `.emacs'." ;; unless some other has been specified. (if (equal current-language-environment "English") (set-language-environment "latin-1")) - (unless (or noninteractive (memq window-system '(x w32 ns))) + (unless (or noninteractive (display-graphic-p)) ;; Send those codes literally to a character-based terminal. ;; If we are using single-byte characters, ;; it doesn't matter which coding system we use. diff --git a/lisp/faces.el b/lisp/faces.el index ab6c384c802..fa526c35061 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -55,6 +55,7 @@ This means to treat a terminal of type TYPE as if it were of type ALIAS." :group 'terminals :version "25.1") +(declare-function display-graphic-p "frame" (&optional display)) (declare-function xw-defined-colors "term/common-win" (&optional frame)) (defvar help-xref-stack-item) @@ -1239,7 +1240,7 @@ of a global face. Value is the new attribute value." ;; explicitly in VALID, using color approximation code ;; in tty-colors.el. (when (and (memq attribute '(:foreground :background)) - (not (memq (window-system frame) '(x w32 ns))) + (not (display-graphic-p frame)) (not (member new-value '("unspecified" "unspecified-fg" "unspecified-bg")))) @@ -1833,7 +1834,7 @@ The argument FRAME specifies which frame to try. The value may be different for frames on different display types. If FRAME doesn't support colors, the value is nil. If FRAME is nil, that stands for the selected frame." - (if (memq (framep (or frame (selected-frame))) '(x w32 ns)) + (if (display-graphic-p frame) (xw-defined-colors frame) (mapcar 'car (tty-color-alist frame)))) (defalias 'x-defined-colors 'defined-colors) @@ -1877,7 +1878,7 @@ or one of the strings \"unspecified-fg\" or \"unspecified-bg\". If FRAME is omitted or nil, use the selected frame." (unless (member color '(unspecified "unspecified-bg" "unspecified-fg")) - (if (member (framep (or frame (selected-frame))) '(x w32 ns)) + (if (display-graphic-p frame) (xw-color-defined-p color frame) (numberp (tty-color-translate color frame))))) (defalias 'x-color-defined-p 'color-defined-p) @@ -1903,7 +1904,7 @@ return value is nil." (cond ((member color '(unspecified "unspecified-fg" "unspecified-bg")) nil) - ((memq (framep (or frame (selected-frame))) '(x w32 ns)) + ((display-graphic-p frame) (xw-color-values color frame)) (t (tty-color-values color frame)))) @@ -1917,7 +1918,7 @@ return value is nil." The optional argument DISPLAY specifies which display to ask about. DISPLAY should be either a frame or a display name (a string). If omitted or nil, that stands for the selected frame's display." - (if (memq (framep-on-display display) '(x w32 ns)) + (if (display-graphic-p display) (xw-display-color-p display) (tty-display-color-p display))) (defalias 'x-display-color-p 'display-color-p) @@ -1928,12 +1929,9 @@ If omitted or nil, that stands for the selected frame's display." "Return non-nil if frames on DISPLAY can display shades of gray. DISPLAY should be either a frame or a display name (a string). If omitted or nil, that stands for the selected frame's display." - (let ((frame-type (framep-on-display display))) - (cond - ((memq frame-type '(x w32 ns)) - (x-display-grayscale-p display)) - (t - (> (tty-color-gray-shades display) 2))))) + (if (display-graphic-p display) + (x-display-grayscale-p display) + (> (tty-color-gray-shades display) 2))) (defun read-color (&optional prompt convert-to-RGB allow-empty-name msg) "Read a color name or RGB triplet. diff --git a/lisp/frame.el b/lisp/frame.el index 6cb12473725..acf6a46716a 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -974,7 +974,7 @@ recently selected windows nor the buffer list." (select-frame frame norecord) (raise-frame frame) ;; Ensure, if possible, that FRAME gets input focus. - (when (memq (window-system frame) '(x w32 ns)) + (when (display-multi-frame-p frame) (x-focus-frame frame)) ;; Move mouse cursor if necessary. (cond @@ -1027,16 +1027,15 @@ that variable should be nil." "Do whatever is right to suspend the current frame. Calls `suspend-emacs' if invoked from the controlling tty device, `suspend-tty' from a secondary tty device, and -`iconify-or-deiconify-frame' from an X frame." +`iconify-or-deiconify-frame' from a graphical frame." (interactive) - (let ((type (framep (selected-frame)))) - (cond - ((memq type '(x ns w32)) (iconify-or-deiconify-frame)) - ((eq type t) - (if (controlling-tty-p) - (suspend-emacs) - (suspend-tty))) - (t (suspend-emacs))))) + (cond + ((display-multi-frame-p) (iconify-or-deiconify-frame)) + ((eq (framep (selected-frame)) t) + (if (controlling-tty-p) + (suspend-emacs) + (suspend-tty))) + (t (suspend-emacs)))) (defun make-frame-names-alist () ;; Only consider the frames on the same display. diff --git a/lisp/info.el b/lisp/info.el index f2a064abb67..f3b413a2f9f 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4768,7 +4768,7 @@ first line or header line, and for breadcrumb links.") ;; This is a serious problem for trying to handle multiple ;; frame types at once. We want this text to be invisible ;; on frames that can display the font above. - (when (memq (framep (selected-frame)) '(x pc w32 ns)) + (when (display-multi-font-p) (add-text-properties (1- (match-beginning 2)) (match-end 2) '(invisible t front-sticky nil rear-nonsticky t)))))) diff --git a/lisp/window.el b/lisp/window.el index b769be06337..b4f5ac5cc44 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9314,6 +9314,8 @@ is active. This function is run by `mouse-autoselect-window-timer'." ;; autoselection. (mouse-autoselect-window-start mouse-position window))))) +(declare-function display-multi-frame-p "frame" (&optional display)) + (defun handle-select-window (event) "Handle select-window events." (interactive "^e") @@ -9351,7 +9353,7 @@ is active. This function is run by `mouse-autoselect-window-timer'." ;; we might get two windows with an active cursor. (select-window window) (cond - ((or (not (memq (window-system frame) '(x w32 ns))) + ((or (not (display-multi-frame-p)) (not focus-follows-mouse) ;; Focus FRAME if it's either a child frame or an ancestor ;; of the frame switched from. From c6ea522de62d6064d5be9dd1ddf69dceb6506780 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Wed, 3 Apr 2019 14:03:42 -0600 Subject: [PATCH 034/121] Define and use new alias display-blink-cursor-p display-graphic-p is not used in this case because it may be possible in the future for terminals to allow control over cursor blinking. For details, see bug#35058. * lisp/frame.el (blink-cursor-mode): Use display-blink-cursor-p. --- lisp/frame.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/frame.el b/lisp/frame.el index acf6a46716a..cc8ca49b3b7 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1905,6 +1905,7 @@ frame's display)." (fboundp 'image-mask-p) (fboundp 'image-size))) +(defalias 'display-blink-cursor-p 'display-graphic-p) (defalias 'display-multi-frame-p 'display-graphic-p) (defalias 'display-multi-font-p 'display-graphic-p) @@ -2545,7 +2546,7 @@ terminals, cursor blinking is controlled by the terminal." :init-value (not (or noninteractive no-blinking-cursor (eq system-type 'ms-dos) - (not (memq window-system '(x w32 ns))))) + (not (display-blink-cursor-p)))) :initialize 'custom-initialize-delay :group 'cursor :global t From cffc04c48dfed59ab9d958b9b64948d5fa491fbe Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Wed, 3 Apr 2019 14:03:28 -0600 Subject: [PATCH 035/121] Define and use new procedure display-symbol-keys-p * lisp/frame.el (display-symbol-keys-p): Define. * lisp/simple.el (normal-erase-is-backspace-setup-frame): Use eq instead of memq. (normal-erase-is-backspace-mode): Use display-symbol-keys-p. --- etc/NEWS | 6 ++++++ lisp/frame.el | 10 ++++++++++ lisp/simple.el | 7 ++++--- 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 26c761ae01f..be4543c0166 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1230,6 +1230,12 @@ the 128...255 range, as expected. This allows to create and parent immediately a minibuffer-only child frame when making a frame. +--- +*** New predicates 'display-blink-cursor-p' and 'display-symbol-keys-p'. +These predicates are to be preferred over 'display-graphic-p' when +testing for blinking cursor capability and the capability to have +symbols (e.g., [return], [tab], [backspace]) as keys respectively. + ** Tabulated List mode +++ diff --git a/lisp/frame.el b/lisp/frame.el index cc8ca49b3b7..aa14e87d7b8 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1927,6 +1927,16 @@ frame's display)." (t nil)))) +(defun display-symbol-keys-p (&optional display) + "Return non-nil if DISPLAY supports symbol names as keys. +This means that, for example, DISPLAY can differentiate between +the keybinding RET and [return]." + (let ((frame-type (framep-on-display display))) + (or (memq frame-type '(x w32 ns pc)) + ;; MS-DOS and MS-Windows terminals have built-in support for + ;; function (symbol) keys + (memq system-type '(ms-dos windows-nt))))) + (declare-function x-display-screens "xfns.c" (&optional terminal)) (defun display-screens (&optional display) diff --git a/lisp/simple.el b/lisp/simple.el index 306df967661..857e0fc001b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8690,7 +8690,7 @@ call `normal-erase-is-backspace-mode' (which see) instead." (and (not noninteractive) (or (memq system-type '(ms-dos windows-nt)) (memq window-system '(w32 ns)) - (and (memq window-system '(x)) + (and (eq window-system 'x) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) ;; If the terminal Emacs is running on has erase char @@ -8701,6 +8701,8 @@ call `normal-erase-is-backspace-mode' (which see) instead." normal-erase-is-backspace) 1 0))))) +(declare-function display-symbol-keys-p "frame" (&optional display)) + (define-minor-mode normal-erase-is-backspace-mode "Toggle the Erase and Delete mode of the Backspace and Delete keys. @@ -8736,8 +8738,7 @@ See also `normal-erase-is-backspace'." (let ((enabled (eq 1 (terminal-parameter nil 'normal-erase-is-backspace)))) - (cond ((or (memq window-system '(x w32 ns pc)) - (memq system-type '(ms-dos windows-nt))) + (cond ((display-symbol-keys-p) (let ((bindings '(([M-delete] [M-backspace]) ([C-M-delete] [C-M-backspace]) From b68405405e5ee4ce7326e6ef32afbde48bafd7fe Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Wed, 3 Apr 2019 14:06:45 -0600 Subject: [PATCH 036/121] Introduce new defcustom for terminal CUA rectangle commands This allows a user to set a non-meta modifier for their terminal should his/her terminal support it. See bug#35058 for background on this change. * lisp/emulation/cua-base.el (cua-rectangle-terminal-modifier-key): New defcustom. * lisp/emulation/cua-base.el (cua--shift-control-x-prefix): Use new defcustom. --- etc/NEWS | 7 +++++++ lisp/emulation/cua-base.el | 19 ++++++++++++++----- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index be4543c0166..c7456c681a2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1252,6 +1252,13 @@ near the current column in Tabulated Lists (see variables +++ *** 'text-mode-variant' is now obsolete, use 'derived-mode-p' instead. +** CUA mode + +--- +*** New defcustom 'cua-rectangle-terminal-modifier-key'. +This defcustom allows for the customization of the modifier key used +in a terminal frame. + * New Modes and Packages in Emacs 27.1 diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 302ef123865..105e1ab43d8 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -427,7 +427,7 @@ and after the region marked by the rectangle to search." (defcustom cua-rectangle-modifier-key 'meta "Modifier key used for rectangle commands bindings. -On non-window systems, always use the meta modifier. +On non-window systems, use `cua-rectangle-terminal-modifier-key'. Must be set prior to enabling CUA." :type '(choice (const :tag "Meta key" meta) (const :tag "Alt key" alt) @@ -435,6 +435,16 @@ Must be set prior to enabling CUA." (const :tag "Super key" super)) :group 'cua) +(defcustom cua-rectangle-terminal-modifier-key 'meta + "Modifier key used for rectangle commands bindings in terminals. +Must be set prior to enabling CUA." + :type '(choice (const :tag "Meta key" meta) + (const :tag "Alt key" alt) + (const :tag "Hyper key" hyper) + (const :tag "Super key" super)) + :group 'cua + :version "27.1") + (defcustom cua-enable-rectangle-auto-help t "If non-nil, automatically show help for region, rectangle and global mark." :type 'boolean @@ -1237,10 +1247,9 @@ If ARG is the atom `-', scroll upward by nearly full screen." (defun cua--init-keymaps () ;; Cache actual rectangle modifier key. (setq cua--rectangle-modifier-key - (if (and cua-rectangle-modifier-key - (memq window-system '(x))) - cua-rectangle-modifier-key - 'meta)) + (if (eq (framep (selected-frame)) t) + cua-rectangle-terminal-modifier-key + cua-rectangle-modifier-key)) ;; C-return always toggles rectangle mark (define-key cua-global-keymap cua-rectangle-mark-key 'cua-set-rectangle-mark) (unless (eq cua--rectangle-modifier-key 'meta) From 0c16bb5a39b38c48374bc3ad4ca99208ff329d46 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Tue, 2 Apr 2019 11:14:18 -0600 Subject: [PATCH 037/121] * lisp/frame.el (display-planes): Use logb over truncate + log Suggested by Basil L. Contovounesios: https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-03/msg01052.html --- lisp/frame.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/frame.el b/lisp/frame.el index aa14e87d7b8..b39891cd142 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2093,7 +2093,7 @@ If DISPLAY is omitted or nil, it defaults to the selected frame's display." ((eq frame-type 'pc) 4) (t - (truncate (log (length (tty-color-alist)) 2)))))) + (logb (length (tty-color-alist))))))) (declare-function x-display-color-cells "xfns.c" (&optional terminal)) From 7e1ad6360e625c61e6b6898996269dd0606a7153 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 7 Apr 2019 10:10:30 +0200 Subject: [PATCH 038/121] * lisp/net/tramp.el (tramp-parse-group): Rename third arg to SKIP-CHARS. (tramp-parse-sconfig-group): Fix thinko. --- lisp/net/tramp.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0fc2d33d222..32963ac5432 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2801,14 +2801,14 @@ for all methods. Resulting data are derived from default settings." :port method :require '(:port) :max most-positive-fixnum)))) ;; Generic function. -(defun tramp-parse-group (regexp match-level skip-regexp) +(defun tramp-parse-group (regexp match-level skip-chars) "Return a (user host) tuple allowed to access. User is always nil." (let (result) (when (re-search-forward regexp (point-at-eol) t) (setq result (list nil (match-string match-level)))) (or - (> (skip-chars-forward skip-regexp) 0) + (> (skip-chars-forward skip-chars) 0) (forward-line 1)) result)) @@ -2864,7 +2864,7 @@ User is always nil." (tramp-parse-group (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)" "\\|" "\\(" tramp-host-regexp "\\)") - 1 "[ \t]+")) + 1 " \t")) ;; Generic function. (defun tramp-parse-shostkeys-sknownhosts (dirname regexp) From f28c20905591670bf8a0bd6c86ebe4d8003b193b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 7 Apr 2019 10:10:52 +0200 Subject: [PATCH 039/121] Fix typo in tramp.texi * doc/misc/tramp.texi (Change file name syntax) (Frequently Asked Questions): '.' or ',' must follow xref. --- doc/misc/tramp.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 771ff1c08ee..e376fc7495e 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2671,7 +2671,7 @@ name syntax. Its value changes after every call of this variable in external packages, a call of @code{file-remote-p} is much more appropriate. @ifinfo -@pxref{Magic File Names, , , elisp} +@pxref{Magic File Names, , , elisp}. @end ifinfo @end defvar @end ifset @@ -3720,7 +3720,7 @@ Set @code{file-precious-flag} to @code{t} for files accessed by @value{tramp} so the file contents are checked using checksum by first saving to a temporary file. @ifinfo -@pxref{Saving Buffers, , , elisp} +@pxref{Saving Buffers, , , elisp}. @end ifinfo @lisp From e71f1dda1f80feb319d4ce5a69e14d36ec59adfd Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 7 Apr 2019 02:44:37 -0700 Subject: [PATCH 040/121] Fix more regexp oddities MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problems reported by Mattias Engdegård in: https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00178.html * lisp/progmodes/sh-script.el (sh-get-indent-info): Reorder skip-chars-forward arg so that it does not look like a regexp. * lisp/progmodes/verilog-mode.el (verilog-sk-define-signal): Fix typo: the string is not a regexp. * lisp/vc/log-edit.el (log-edit-goto-eoh): Fix typo: stray ‘:’. * lisp/xml.el (xml-parse-dtd): Avoid ‘-’ right after char class. --- lisp/progmodes/sh-script.el | 3 +-- lisp/progmodes/verilog-mode.el | 2 +- lisp/vc/log-edit.el | 2 +- lisp/xml.el | 4 ++-- 4 files changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index dd3a6fa411e..853a3500ee1 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2905,8 +2905,7 @@ STRING This is ignored for the purposes of calculating (setq align-point (point)))) (or (bobp) (forward-char -1)) - ;; FIXME: This charset looks too much like a regexp. --Stef - (skip-chars-forward "[a-z0-9]*?") + (skip-chars-forward "*0-9?[]a-z") ) ((string-match "[])}]" x) (setq x (sh-safe-forward-sexp -1)) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 7b9c3921fba..916594bdde0 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -14263,7 +14263,7 @@ and the case items." (defun verilog-sk-define-signal () "Insert a definition of signal under point at top of module." (interactive "*") - (let* ((sig-re "[a-zA-Z0-9_]*") + (let* ((sig-re "a-zA-Z0-9_") (v1 (buffer-substring (save-excursion (skip-chars-backward sig-re) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 8bd1bbddb78..42710dd8dc9 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -350,7 +350,7 @@ The first subexpression is the actual text of the field.") (defun log-edit-goto-eoh () ;FIXME: Almost rfc822-goto-eoh! (goto-char (point-min)) (when (re-search-forward - "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-:]\\)" nil 'move) + "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-]\\)" nil 'move) (goto-char (match-beginning 0)))) (defun log-edit--match-first-line (limit) diff --git a/lisp/xml.el b/lisp/xml.el index 2337952f064..b5b923f863e 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -718,10 +718,10 @@ This follows the rule [28] in the XML specifications." (cond ((looking-at "PUBLIC\\s-+") (goto-char (match-end 0)) (unless (or (re-search-forward - "\\=\"\\([[:space:][:alnum:]-'()+,./:=?;!*#@$_%]*\\)\"" + "\\=\"\\([[:space:][:alnum:]'()+,./:=?;!*#@$_%-]*\\)\"" nil t) (re-search-forward - "\\='\\([[:space:][:alnum:]-()+,./:=?;!*#@$_%]*\\)'" + "\\='\\([[:space:][:alnum:]()+,./:=?;!*#@$_%-]*\\)'" nil t)) (error "XML: Missing Public ID")) (let ((pubid (match-string-no-properties 1))) From 74732c541228ebb9f0a15b0a22132a85b32de89b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 7 Apr 2019 11:36:50 -0700 Subject: [PATCH 041/121] Help the compiler with byte order * src/xsettings.c (parse_settings): Help the compiler by letting it deduce the native endianness at compile-time. --- src/xsettings.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/xsettings.c b/src/xsettings.c index 0c5e36d9d69..947d5cfb7b6 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -393,8 +393,8 @@ parse_settings (unsigned char *prop, unsigned long bytes, struct xsettings *settings) { - Lisp_Object byteorder = Fbyteorder (); - int my_bo = XFIXNAT (byteorder) == 'B' ? MSBFirst : LSBFirst; + int int1 = 1; + int my_bo = *(char *) &int1 == 1 ? LSBFirst : MSBFirst; int that_bo = prop[0]; CARD32 n_settings; int bytes_parsed = 0; From 404a5470cf1b1ae5bd464aaf8fe909b86faa2e61 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 7 Apr 2019 11:43:17 -0700 Subject: [PATCH 042/121] Simplify fill_gstring_header * src/composite.c (fill_gstring_header): Omit first argument HEADER, since in practice it is always nil. Change caller to match. Help the compiler by telling it LEN is nonnegative. Problem found with --enable-gcc-warnings and gcc -O2 -Og. --- src/composite.c | 25 ++++++++----------------- 1 file changed, 8 insertions(+), 17 deletions(-) diff --git a/src/composite.c b/src/composite.c index c426cbb1246..88f1235f116 100644 --- a/src/composite.c +++ b/src/composite.c @@ -787,28 +787,19 @@ static Lisp_Object gstring_work; static Lisp_Object gstring_work_headers; static Lisp_Object -fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte, +fill_gstring_header (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t to, Lisp_Object font_object, Lisp_Object string) { - ptrdiff_t len = to - from, i; - + ptrdiff_t len = to - from; if (len == 0) error ("Attempt to shape zero-length text"); - if (VECTORP (header)) - { - if (ASIZE (header) != len + 1) - args_out_of_range (header, make_fixnum (len + 1)); - } - else - { - if (len <= 8) - header = AREF (gstring_work_headers, len - 1); - else - header = make_uninit_vector (len + 1); - } + eassume (0 < len); + Lisp_Object header = (len <= 8 + ? AREF (gstring_work_headers, len - 1) + : make_uninit_vector (len + 1)); ASET (header, 0, font_object); - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { int c; @@ -1748,7 +1739,7 @@ should be ignored. */) frombyte = string_char_to_byte (string, frompos); } - header = fill_gstring_header (Qnil, frompos, frombyte, + header = fill_gstring_header (frompos, frombyte, topos, font_object, string); gstring = gstring_lookup_cache (header); if (! NILP (gstring)) From a35e06bbe27c5907f56c5aeb48182d7be00d1dec Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Sat, 6 Apr 2019 23:02:24 -0600 Subject: [PATCH 043/121] Plug memory leak in GTK x-display-monitor-attributes-list * src/frame.c (free_monitors) [USE_GTK]: Define in the GTK case as well. * src/xfns.c (x-display-monitor-attributes-list) [USE_GTK]: Plug memory leak. * src/frame.h (MonitorInfo): Declare name as pointing to const char. --- src/frame.c | 4 ++-- src/frame.h | 2 +- src/xfns.c | 7 ++++++- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/src/frame.c b/src/frame.c index d0c77149ba8..6fdb7d0cbb9 100644 --- a/src/frame.c +++ b/src/frame.c @@ -5662,8 +5662,8 @@ selected frame. This is useful when `make-pointer-invisible' is set. */) #ifdef HAVE_WINDOW_SYSTEM -# if (defined HAVE_NS \ - || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR))) +# if (defined USE_GTK || defined HAVE_NS || defined HAVE_XINERAMA \ + || defined HAVE_XRANDR) void free_monitors (struct MonitorInfo *monitors, int n_monitors) { diff --git a/src/frame.h b/src/frame.h index ed62e7ace0f..b1eedf36a38 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1648,7 +1648,7 @@ flush_frame (struct frame *f) struct MonitorInfo { XRectangle geom, work; int mm_width, mm_height; - char *name; + const char *name; }; extern void free_monitors (struct MonitorInfo *monitors, int n_monitors); diff --git a/src/xfns.c b/src/xfns.c index f238a3daa15..9a25b00b20e 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5030,7 +5030,7 @@ Internal use only, use `display-monitor-attributes-list' instead. */) mi->mm_height = height_mm; #if GTK_CHECK_VERSION (3, 22, 0) - mi->name = g_strdup (gdk_monitor_get_model (monitor)); + mi->name = xstrdup (gdk_monitor_get_model (monitor)); #elif GTK_CHECK_VERSION (2, 14, 0) mi->name = gdk_screen_get_monitor_plug_name (gscreen, i); #endif @@ -5041,6 +5041,11 @@ Internal use only, use `display-monitor-attributes-list' instead. */) primary_monitor, monitor_frames, source); +#if GTK_CHECK_VERSION (2, 14, 0) + free_monitors (monitors, n_monitors); +#else + xfree (monitors) +#endif unblock_input (); #else /* not USE_GTK */ From 6dfe231c3197971fc0cdddcc1299200da80f3729 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 7 Apr 2019 20:50:40 +0200 Subject: [PATCH 044/121] Rename variable for clarity * lisp/progmodes/verilog-mode.el (verilog-sk-define-signal): Rename sig-re to sig-chars, to make it clear that it isn't a regexp. --- lisp/progmodes/verilog-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 916594bdde0..9226291ffbb 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -14263,13 +14263,13 @@ and the case items." (defun verilog-sk-define-signal () "Insert a definition of signal under point at top of module." (interactive "*") - (let* ((sig-re "a-zA-Z0-9_") + (let* ((sig-chars "a-zA-Z0-9_") (v1 (buffer-substring (save-excursion - (skip-chars-backward sig-re) + (skip-chars-backward sig-chars) (point)) (save-excursion - (skip-chars-forward sig-re) + (skip-chars-forward sig-chars) (point))))) (if (not (member v1 verilog-keywords)) (save-excursion From 7b78857c0ba69eafd780484641b858ae8a167044 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Sun, 7 Apr 2019 12:53:41 -0600 Subject: [PATCH 045/121] ; * src/xfns.c (x-display-monitor-attributes-list) Fix typo. --- src/xfns.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xfns.c b/src/xfns.c index 9a25b00b20e..13f66f07183 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5044,7 +5044,7 @@ Internal use only, use `display-monitor-attributes-list' instead. */) #if GTK_CHECK_VERSION (2, 14, 0) free_monitors (monitors, n_monitors); #else - xfree (monitors) + xfree (monitors); #endif unblock_input (); #else /* not USE_GTK */ From 0b8117ed1abfc17bb0bc1690a8997736f1e8f98c Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Sun, 7 Apr 2019 19:17:48 -0600 Subject: [PATCH 046/121] ; * src/frame.h (MonitorInfo): Remove const modifier This removes a compiler warning with xfree. --- src/frame.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/frame.h b/src/frame.h index b1eedf36a38..ed62e7ace0f 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1648,7 +1648,7 @@ flush_frame (struct frame *f) struct MonitorInfo { XRectangle geom, work; int mm_width, mm_height; - const char *name; + char *name; }; extern void free_monitors (struct MonitorInfo *monitors, int n_monitors); From a20845c160de2ba9f42b3af714d770df502d0577 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 8 Apr 2019 13:34:54 +0200 Subject: [PATCH 047/121] Fix file-readable-p and file-executable-p in some Tramp backends * lisp/net/tramp-archive.el (tramp-archive-handle-file-readable-p): Use tramp-gvfs. * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-executable-p): Check that FILENAME exists. (tramp-gvfs-handle-file-readable-p): Check that FILENAME exists. Use heuristic in case it cannot be determined correctly. --- lisp/net/tramp-archive.el | 4 +--- lisp/net/tramp-gvfs.el | 18 ++++++++++++++++-- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 9e131b1a47d..ba4c26cdf2f 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -584,9 +584,7 @@ offered." (defun tramp-archive-handle-file-readable-p (filename) "Like `file-readable-p' for file archives." - (with-parsed-tramp-file-name - (tramp-archive-gvfs-file-name filename) nil - (tramp-check-cached-permissions v ?r))) + (file-readable-p (tramp-archive-gvfs-file-name filename))) (defun tramp-archive-handle-file-system-info (filename) "Like `file-system-info' for file archives." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 2d8f42004a8..8fea82d97c4 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1136,7 +1136,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `file-executable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-executable-p" - (tramp-check-cached-permissions v ?x)))) + (and (file-exists-p filename) + (tramp-check-cached-permissions v ?x))))) (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -1258,7 +1259,20 @@ file-notify events." "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-readable-p" - (tramp-check-cached-permissions v ?r)))) + (and (file-exists-p filename) + (or (tramp-check-cached-permissions v ?r) + ;; If the user is different from what we guess to be + ;; the user, we don't know. Let's check, whether + ;; access is restricted explicitly. + (and (/= (tramp-gvfs-get-remote-uid v 'integer) + (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer))) + (not + (string-equal + "FALSE" + (cdr (assoc + "access::can-read" + (tramp-gvfs-get-file-attributes filename))))))))))) (defun tramp-gvfs-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." From a5da653319a3018074debfc7b4fdd90ac7ea838c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 8 Apr 2019 19:53:48 +0300 Subject: [PATCH 048/121] * src/editfns.c (Fnarrow_to_region): Doc fix. (Bug#35163) --- src/editfns.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/editfns.c b/src/editfns.c index f5edbb71d2e..9b76ae23ffd 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3840,8 +3840,9 @@ but is not deleted; if you save the buffer in a file, the invisible text is included in the file. \\[widen] makes all visible again. See also `save-restriction'. -When calling from a program, pass two arguments; positions (integers -or markers) bounding the text that should remain visible. */) +When calling from Lisp, pass two arguments START and END: +positions (integers or markers) bounding the text that should +remain visible. */) (register Lisp_Object start, Lisp_Object end) { CHECK_NUMBER_COERCE_MARKER (start); From 0d5e83611e5157800fd855fe8e3f60c8eff0af7c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Apr 2019 14:28:34 -0400 Subject: [PATCH 049/121] Eshell: Try to untangle the dependencies; move 'provide's to the end * lisp/eshell/esh-arg.el: Move defsubst and vars before first use. Don't require `esh-mode but esh-util instead. * lisp/eshell/esh-cmd.el: Require esh-module and esh-io. * lisp/eshell/esh-ext.el: Don't require esh-proc nor esh-cmd. (eshell-external-command): Require esh-proc for eshell-gather-process-output. * lisp/eshell/esh-mode.el: Don't require esh-io nor esh-var, but require esh-arg. (eshell-directory-name): Move from eshell.el. * lisp/eshell/esh-module.el: Don't require eshell. * lisp/eshell/esh-opt.el: Don't require esh-ext at top-level. (eshell--do-opts, eshell-show-usage): Require it here instead. * lisp/eshell/esh-proc.el: Don't require esh-cmd, but require esh-io. (eshell-reset-after-proc, eshell-record-process-object) (eshell-gather-process-output, eshell-send-eof-to-process): Require esh-mode and esh-var here. * lisp/eshell/esh-var.el: Require esh-module, esh-arg, and esh-io. * lisp/eshell/eshell.el: Require esh-module, esh-proc, esh-io, and esh-cmd. But don't require esh-mode. (eshell-directory-name): Move to esh-mode. (eshell-return-exits-minibuffer): Don't bind 'return' and 'M-return' since we already bind RET and M-RET. --- lisp/eshell/em-hist.el | 20 +++++---- lisp/eshell/em-term.el | 2 +- lisp/eshell/esh-arg.el | 94 ++++++++++++++++++++------------------- lisp/eshell/esh-cmd.el | 4 +- lisp/eshell/esh-ext.el | 18 +++----- lisp/eshell/esh-io.el | 3 +- lisp/eshell/esh-mode.el | 33 +++++++------- lisp/eshell/esh-module.el | 4 +- lisp/eshell/esh-opt.el | 8 ++-- lisp/eshell/esh-proc.el | 59 +++++++++++++++--------- lisp/eshell/esh-var.el | 19 +++++--- lisp/eshell/eshell.el | 24 +++++----- 12 files changed, 154 insertions(+), 134 deletions(-) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 05579eed32a..bc0da96c588 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -59,6 +59,7 @@ (require 'ring) (require 'esh-opt) +(require 'esh-mode) (require 'em-pred) (require 'eshell) @@ -192,7 +193,6 @@ element, regardless of any text on the command line. In that case, (defvar eshell-isearch-map (let ((map (copy-keymap isearch-mode-map))) (define-key map [(control ?m)] 'eshell-isearch-return) - (define-key map [return] 'eshell-isearch-return) (define-key map [(control ?r)] 'eshell-isearch-repeat-backward) (define-key map [(control ?s)] 'eshell-isearch-repeat-forward) (define-key map [(control ?g)] 'eshell-isearch-abort) @@ -220,7 +220,7 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." "Initialize the history management code for one Eshell buffer." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook - 'eshell-complete-history-reference nil t)) + #'eshell-complete-history-reference nil t)) (if (and (eshell-using-module 'eshell-rebind) (not eshell-non-interactive-p)) @@ -235,11 +235,13 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (lambda () (if (>= (point) eshell-last-output-end) (setq overriding-terminal-local-map - eshell-isearch-map)))) nil t) + eshell-isearch-map)))) + nil t) (add-hook 'isearch-mode-end-hook (function (lambda () - (setq overriding-terminal-local-map nil))) nil t)) + (setq overriding-terminal-local-map nil))) + nil t)) (define-key eshell-mode-map [up] 'eshell-previous-matching-input-from-input) (define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input) (define-key eshell-mode-map [(control up)] 'eshell-previous-input) @@ -288,17 +290,17 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (if eshell-history-file-name (eshell-read-history nil t)) - (add-hook 'eshell-exit-hook 'eshell-write-history nil t)) + (add-hook 'eshell-exit-hook #'eshell-write-history nil t)) (unless eshell-history-ring (setq eshell-history-ring (make-ring eshell-history-size))) - (add-hook 'eshell-exit-hook 'eshell-write-history nil t) + (add-hook 'eshell-exit-hook #'eshell-write-history nil t) - (add-hook 'kill-emacs-hook 'eshell-save-some-history) + (add-hook 'kill-emacs-hook #'eshell-save-some-history) (make-local-variable 'eshell-input-filter-functions) - (add-hook 'eshell-input-filter-functions 'eshell-add-to-history nil t) + (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t) (define-key eshell-command-map [(control ?l)] 'eshell-list-history) (define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history)) @@ -754,7 +756,7 @@ matched." (setq nth (eshell-hist-word-reference nth))) (unless (numberp mth) (setq mth (eshell-hist-word-reference mth))) - (cons (mapconcat 'identity (eshell-sublist textargs nth mth) " ") + (cons (mapconcat #'identity (eshell-sublist textargs nth mth) " ") end)))) (defun eshell-hist-parse-modifier (hist reference) diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 8af783eaf80..9a9f23cddd9 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -191,7 +191,7 @@ allowed." (term-exec term-buf program program nil args) (let ((proc (get-buffer-process term-buf))) (if (and proc (eq 'run (process-status proc))) - (set-process-sentinel proc 'eshell-term-sentinel) + (set-process-sentinel proc #'eshell-term-sentinel) (error "Failed to invoke visual command"))) (term-char-mode) (if eshell-escape-control-x diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 360202b6539..3ba4c935a72 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -25,9 +25,9 @@ ;; hook `eshell-parse-argument-hook'. For a good example of this, see ;; `eshell-parse-drive-letter', defined in eshell-dirs.el. -(provide 'esh-arg) +;;; Code: -(require 'esh-mode) +(require 'esh-util) (defgroup eshell-arg nil "Argument parsing involves transforming the arguments passed on the @@ -36,6 +36,48 @@ yield the values intended." :tag "Argument parsing" :group 'eshell) +;;; Internal Variables: + +(defvar eshell-current-argument nil) +(defvar eshell-current-modifiers nil) +(defvar eshell-arg-listified nil) +(defvar eshell-nested-argument nil) +(defvar eshell-current-quoted nil) +(defvar eshell-inside-quote-regexp nil) +(defvar eshell-outside-quote-regexp nil) + +;;; User Variables: + +(defcustom eshell-arg-load-hook nil + "A hook that gets run when `eshell-arg' is loaded." + :version "24.1" ; removed eshell-arg-initialize + :type 'hook + :group 'eshell-arg) + +(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n) + "List of characters to recognize as argument separators." + :type '(repeat character) + :group 'eshell-arg) + +(defcustom eshell-special-chars-inside-quoting '(?\\ ?\") + "Characters which are still special inside double quotes." + :type '(repeat character) + :group 'eshell-arg) + +(defcustom eshell-special-chars-outside-quoting + (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\')) + "Characters that require escaping outside of double quotes. +Without escaping them, they will introduce a change in the argument." + :type '(repeat character) + :group 'eshell-arg) + +(defsubst eshell-arg-delimiter (&optional pos) + "Return non-nil if POS is an argument delimiter. +If POS is nil, the location of point is checked." + (let ((pos (or pos (point)))) + (or (= pos (point-max)) + (memq (char-after pos) eshell-delimiter-argument-list)))) + (defcustom eshell-parse-argument-hook (list ;; a term such as #, or # is a buffer @@ -113,47 +155,13 @@ treated as a literal character." :type 'hook :group 'eshell-arg) -;;; Code: - -;;; User Variables: - -(defcustom eshell-arg-load-hook nil - "A hook that gets run when `eshell-arg' is loaded." - :version "24.1" ; removed eshell-arg-initialize - :type 'hook - :group 'eshell-arg) - -(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n) - "List of characters to recognize as argument separators." - :type '(repeat character) - :group 'eshell-arg) - -(defcustom eshell-special-chars-inside-quoting '(?\\ ?\") - "Characters which are still special inside double quotes." - :type '(repeat character) - :group 'eshell-arg) - -(defcustom eshell-special-chars-outside-quoting - (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\')) - "Characters that require escaping outside of double quotes. -Without escaping them, they will introduce a change in the argument." - :type '(repeat character) - :group 'eshell-arg) - -;;; Internal Variables: - -(defvar eshell-current-argument nil) -(defvar eshell-current-modifiers nil) -(defvar eshell-arg-listified nil) -(defvar eshell-nested-argument nil) -(defvar eshell-current-quoted nil) -(defvar eshell-inside-quote-regexp nil) -(defvar eshell-outside-quote-regexp nil) - ;;; Functions: (defun eshell-arg-initialize () "Initialize the argument parsing code." + ;; This is supposedly run after enabling esh-mode, when eshell-mode-map + ;; already exists. + (defvar eshell-command-map) (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name) (set (make-local-variable 'eshell-inside-quote-regexp) nil) (set (make-local-variable 'eshell-outside-quote-regexp) nil)) @@ -195,13 +203,6 @@ Without escaping them, they will introduce a change in the argument." (setq eshell-current-argument argument)) (throw 'eshell-arg-done t)) -(defsubst eshell-arg-delimiter (&optional pos) - "Return non-nil if POS is an argument delimiter. -If POS is nil, the location of point is checked." - (let ((pos (or pos (point)))) - (or (= pos (point-max)) - (memq (char-after pos) eshell-delimiter-argument-list)))) - (defun eshell-quote-argument (string) "Return STRING with magic characters quoted. Magic characters are those in `eshell-special-chars-outside-quoting'." @@ -405,4 +406,5 @@ If the form has no `type', the syntax is parsed as if `type' were (char-to-string (char-after))))) (goto-char end))))))) +(provide 'esh-arg) ;;; esh-arg.el ends here diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 1ed5d5d7018..7b05cfbc341 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -105,6 +105,8 @@ (require 'eldoc)) (require 'esh-arg) (require 'esh-proc) +(require 'esh-module) +(require 'esh-io) (require 'esh-ext) (eval-when-compile @@ -1337,7 +1339,7 @@ messages, and errors." (eshell-print "\n")) (eshell-close-handles 0 (list 'quote result))))) -(defalias 'eshell-lisp-command* 'eshell-lisp-command) +(defalias 'eshell-lisp-command* #'eshell-lisp-command) (provide 'esh-cmd) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 35ebd36b291..ae8bf846249 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -31,17 +31,12 @@ ;;; Code: -(provide 'esh-ext) - (require 'esh-util) -(eval-when-compile - (require 'cl-lib) - (require 'esh-cmd)) +(eval-when-compile (require 'cl-lib)) (require 'esh-io) (require 'esh-arg) (require 'esh-opt) -(require 'esh-proc) (defgroup eshell-ext nil "External commands are invoked when operating system executables are @@ -179,7 +174,7 @@ external version." (defun eshell-ext-initialize () "Initialize the external command handling code." - (add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t)) + (add-hook 'eshell-named-command-hook #'eshell-explicit-command nil t)) (defun eshell-explicit-command (command args) "If a command name begins with `*', call it externally always. @@ -193,8 +188,6 @@ This bypasses all Lisp functions and aliases." (error "%s: external command not found" (substring command 1)))))) -(autoload 'eshell-close-handles "esh-io") - (defun eshell-remote-command (command args) "Insert output from a remote COMMAND, using ARGS. A remote command is something that executes on a different machine. @@ -211,7 +204,7 @@ causing the user to wonder if anything's really going on..." (progn (setq exitcode (shell-command - (mapconcat 'shell-quote-argument + (mapconcat #'shell-quote-argument (append (list command) args) " ") outbuf errbuf)) (eshell-print (with-current-buffer outbuf (buffer-string))) @@ -235,6 +228,8 @@ causing the user to wonder if anything's really going on..." (cl-assert interp) (if (functionp (car interp)) (apply (car interp) (append (cdr interp) args)) + (require 'esh-proc) + (declare-function eshell-gather-process-output "esh-proc" (command args)) (eshell-gather-process-output (car interp) (append (cdr interp) args))))) @@ -249,7 +244,7 @@ Adds the given PATH to $PATH.") (if args (progn (setq eshell-path-env (getenv "PATH") - args (mapconcat 'identity args path-separator) + args (mapconcat #'identity args path-separator) eshell-path-env (if prepend (concat args path-separator eshell-path-env) @@ -336,4 +331,5 @@ line of the form #!." (cdr interp))))) (or interp (list fullname))))))) +(provide 'esh-ext) ;;; esh-ext.el ends here diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index c33e7325a82..1a6c71eda03 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -68,8 +68,6 @@ ;;; Code: -(provide 'esh-io) - (require 'esh-arg) (require 'esh-util) @@ -511,4 +509,5 @@ Returns what was actually sent, or nil if nothing was sent." (eshell-output-object-to-target object (car target)) (setq target (cdr target)))))) +(provide 'esh-io) ;;; esh-io.el ends here diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 0a160b9ab37..1f86dacd96c 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -58,13 +58,10 @@ ;;; Code: -(provide 'esh-mode) - (require 'esh-util) (require 'esh-module) (require 'esh-cmd) -(require 'esh-io) -(require 'esh-var) +(require 'esh-arg) ;For eshell-parse-arguments (defgroup eshell-mode nil "This module contains code for handling input from the user." @@ -202,6 +199,12 @@ This is used by `eshell-watch-for-password-prompt'." :type 'boolean :group 'eshell-mode) +(defcustom eshell-directory-name + (locate-user-emacs-file "eshell/" ".eshell/") + "The directory where Eshell control files should be kept." + :type 'directory + :group 'eshell) + (defvar eshell-first-time-p t "A variable which is non-nil the first time Eshell is loaded.") @@ -292,7 +295,7 @@ and the hook `eshell-exit-hook'." ;; It's fine to run this unconditionally since it can be customized ;; via the `eshell-kill-processes-on-exit' variable. (and (fboundp 'eshell-query-kill-processes) - (not (memq 'eshell-query-kill-processes eshell-exit-hook)) + (not (memq #'eshell-query-kill-processes eshell-exit-hook)) (eshell-query-kill-processes)) (run-hooks 'eshell-exit-hook)) @@ -334,7 +337,6 @@ and the hook `eshell-exit-hook'." (define-key eshell-command-map [(control ?b)] 'eshell-backward-argument) (define-key eshell-command-map [(control ?e)] 'eshell-show-maximum-output) (define-key eshell-command-map [(control ?f)] 'eshell-forward-argument) - (define-key eshell-command-map [return] 'eshell-copy-old-input) (define-key eshell-command-map [(control ?m)] 'eshell-copy-old-input) (define-key eshell-command-map [(control ?o)] 'eshell-kill-output) (define-key eshell-command-map [(control ?r)] 'eshell-show-output) @@ -414,19 +416,19 @@ and the hook `eshell-exit-hook'." (and initfunc (fboundp initfunc) (funcall initfunc)))) (if eshell-send-direct-to-subprocesses - (add-hook 'pre-command-hook 'eshell-intercept-commands t t)) + (add-hook 'pre-command-hook #'eshell-intercept-commands t t)) (if eshell-scroll-to-bottom-on-input - (add-hook 'pre-command-hook 'eshell-preinput-scroll-to-bottom t t)) + (add-hook 'pre-command-hook #'eshell-preinput-scroll-to-bottom t t)) (when eshell-scroll-show-maximum-output (set (make-local-variable 'scroll-conservatively) 1000)) (when eshell-status-in-mode-line - (add-hook 'eshell-pre-command-hook 'eshell-command-started nil t) - (add-hook 'eshell-post-command-hook 'eshell-command-finished nil t)) + (add-hook 'eshell-pre-command-hook #'eshell-command-started nil t) + (add-hook 'eshell-post-command-hook #'eshell-command-finished nil t)) - (add-hook 'kill-buffer-hook 'eshell-kill-buffer-function t t) + (add-hook 'kill-buffer-hook #'eshell-kill-buffer-function t t) (if eshell-first-time-p (run-hooks 'eshell-first-time-mode-hook)) @@ -451,10 +453,10 @@ and the hook `eshell-exit-hook'." (if eshell-send-direct-to-subprocesses (progn (setq eshell-send-direct-to-subprocesses nil) - (remove-hook 'pre-command-hook 'eshell-intercept-commands t) + (remove-hook 'pre-command-hook #'eshell-intercept-commands t) (message "Sending subprocess input on RET")) (setq eshell-send-direct-to-subprocesses t) - (add-hook 'pre-command-hook 'eshell-intercept-commands t t) + (add-hook 'pre-command-hook #'eshell-intercept-commands t t) (message "Sending subprocess input directly"))) (defun eshell-self-insert-command () @@ -543,7 +545,7 @@ and the hook `eshell-exit-hook'." "Push a mark at the end of the last input text." (push-mark (1- eshell-last-input-end) t)) -(custom-add-option 'eshell-pre-command-hook 'eshell-push-command-mark) +(custom-add-option 'eshell-pre-command-hook #'eshell-push-command-mark) (defsubst eshell-goto-input-start () "Goto the start of the last command input. @@ -551,7 +553,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-goto-input-start) +(custom-add-option 'eshell-pre-command-hook #'eshell-goto-input-start) (defsubst eshell-interactive-print (string) "Print STRING to the eshell display buffer." @@ -1021,4 +1023,5 @@ This function could be in the list `eshell-output-filter-functions'." (custom-add-option 'eshell-output-filter-functions 'eshell-handle-ansi-color) +(provide 'esh-mode) ;;; esh-mode.el ends here diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el index 2583044a446..1911a49a3a4 100644 --- a/lisp/eshell/esh-module.el +++ b/lisp/eshell/esh-module.el @@ -22,9 +22,6 @@ ;;; Code: -(provide 'esh-module) - -(require 'eshell) (require 'esh-util) (defgroup eshell-module nil @@ -101,4 +98,5 @@ customization group. Example: `eshell-cmpl' for that module." (unload-feature module) (message "Unloading %s...done" (symbol-name module)))))) +(provide 'esh-module) ;;; esh-module.el ends here diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index a023a3c5d2e..5b2693283a7 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -23,9 +23,6 @@ ;;; Code: -(provide 'esh-opt) - -(require 'esh-ext) ;; Unused. ;; (defgroup eshell-opt nil @@ -127,6 +124,8 @@ let-bound variable `args'." (defun eshell--do-opts (name options args) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." + (require 'esh-ext) + (declare-function eshell-external-command "esh-ext" (command args)) (let ((ext-command (catch 'eshell-ext-command (let ((usage-msg @@ -145,6 +144,8 @@ This code doesn't really need to be macro expanded everywhere." (defun eshell-show-usage (name options) "Display the usage message for NAME, using OPTIONS." + (require 'esh-ext) + (declare-function eshell-search-path "esh-ext" (name)) (let ((usage (format "usage: %s %s\n\n" name (cadr (memq ':usage options)))) (extcmd (memq ':external options)) @@ -273,4 +274,5 @@ switch is unrecognized." (setq index (1+ index)))))))) (nconc (mapcar #'cdr opt-vals) eshell--args))) +(provide 'esh-opt) ;;; esh-opt.el ends here diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 3432582cf4b..d9a6eef7169 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -23,9 +23,7 @@ ;;; Code: -(provide 'esh-proc) - -(require 'esh-cmd) +(require 'esh-io) (defgroup eshell-proc nil "When Eshell invokes external commands, it always does so @@ -118,14 +116,17 @@ information, for example." Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments PROC and STATUS to functions on the latter." ;; Was there till 24.1, but it is not optional. - (if (memq 'eshell-reset-after-proc eshell-kill-hook) - (setq eshell-kill-hook (delq 'eshell-reset-after-proc eshell-kill-hook))) + (if (memq #'eshell-reset-after-proc eshell-kill-hook) + (setq eshell-kill-hook (delq #'eshell-reset-after-proc eshell-kill-hook))) (eshell-reset-after-proc status) (run-hook-with-args 'eshell-kill-hook proc status)) (defun eshell-proc-initialize () "Initialize the process handling code." (make-local-variable 'eshell-process-list) + ;; This is supposedly run after enabling esh-mode, when eshell-command-map + ;; already exists. + (defvar eshell-command-map) (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process) (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process) (define-key eshell-command-map [(control ?k)] 'eshell-kill-process) @@ -139,9 +140,11 @@ PROC and STATUS to functions on the latter." "Reset the command input location after a process terminates. The signals which will cause this to happen are matched by `eshell-reset-signals'." - (if (and (stringp status) - (string-match eshell-reset-signals status)) - (eshell-reset))) + (when (and (stringp status) + (string-match eshell-reset-signals status)) + (require 'esh-mode) + (declare-function eshell-reset "esh-mode" (&optional no-hooks)) + (eshell-reset))) (defun eshell-wait-for-process (&rest procs) "Wait until PROC has successfully completed." @@ -209,7 +212,8 @@ The prompt will be set to PROMPT." (function (lambda (proc) (cons (process-name proc) t))) - (process-list)) nil t)) + (process-list)) + nil t)) (defun eshell-insert-process (process) "Insert the name of PROCESS into the current buffer at point." @@ -220,10 +224,12 @@ The prompt will be set to PROMPT." (defsubst eshell-record-process-object (object) "Record OBJECT as now running." - (if (and (eshell-processp object) - eshell-current-subjob-p) - (eshell-interactive-print - (format "[%s] %d\n" (process-name object) (process-id object)))) + (when (and (eshell-processp object) + eshell-current-subjob-p) + (require 'esh-mode) + (declare-function eshell-interactive-print "esh-mode" (string)) + (eshell-interactive-print + (format "[%s] %d\n" (process-name object) (process-id object)))) (setq eshell-process-list (cons (list object eshell-current-handles eshell-current-subjob-p nil nil) @@ -254,7 +260,7 @@ the full name of a command, otherwise just the nondirectory part must match.") (defun eshell-needs-pipe-p (command) "Return non-nil if COMMAND needs `process-connection-type' to be nil. See `eshell-needs-pipe'." - (and eshell-in-pipeline-p + (and (bound-and-true-p eshell-in-pipeline-p) (not (eq eshell-in-pipeline-p 'first)) ;; FIXME should this return non-nil for anything that is ;; neither 'first nor 'last? See bug#1388 discussion. @@ -267,6 +273,8 @@ See `eshell-needs-pipe'." (defun eshell-gather-process-output (command args) "Gather the output from COMMAND + ARGS." + (require 'esh-var) + (declare-function eshell-environment-variables "esh-var" ()) (unless (and (file-executable-p command) (file-regular-p (file-truename command))) (error "%s: not an executable file" command)) @@ -283,14 +291,14 @@ See `eshell-needs-pipe'." (unless (eshell-needs-pipe-p command) process-connection-type)) (command (file-local-name (expand-file-name command)))) - (apply 'start-file-process + (apply #'start-file-process (file-name-nondirectory command) nil command args))) (eshell-record-process-object proc) (set-process-buffer proc (current-buffer)) - (if (eshell-interactive-output-p) - (set-process-filter proc 'eshell-output-filter) - (set-process-filter proc 'eshell-insertion-filter)) - (set-process-sentinel proc 'eshell-sentinel) + (set-process-filter proc (if (eshell-interactive-output-p) + #'eshell-output-filter + #'eshell-insertion-filter)) + (set-process-sentinel proc #'eshell-sentinel) (run-hook-with-args 'eshell-exec-hook proc) (when (fboundp 'process-coding-system) (let ((coding-systems (process-coding-system proc))) @@ -325,14 +333,14 @@ See `eshell-needs-pipe'." (set-buffer oldbuf) (run-hook-with-args 'eshell-exec-hook command) (setq exit-status - (apply 'call-process-region + (apply #'call-process-region (append (list eshell-last-sync-output-start (point) command t eshell-scratch-buffer nil) args))) ;; When in a pipeline, record the place where the output of ;; this process will begin. - (and eshell-in-pipeline-p + (and (bound-and-true-p eshell-in-pipeline-p) (set-marker eshell-last-sync-output-start (point))) ;; Simulate the effect of the process filter. (when (numberp exit-status) @@ -349,11 +357,14 @@ See `eshell-needs-pipe'." (setq lbeg lend) (set-buffer proc-buf)) (set-buffer oldbuf)) + (require 'esh-mode) + (declare-function eshell-update-markers "esh-mode" (pmark)) + (defvar eshell-last-output-end) ;Defined in esh-mode.el. (eshell-update-markers eshell-last-output-end) ;; Simulate the effect of eshell-sentinel. (eshell-close-handles (if (numberp exit-status) exit-status -1)) (eshell-kill-process-function command exit-status) - (or eshell-in-pipeline-p + (or (bound-and-true-p eshell-in-pipeline-p) (setq eshell-last-sync-output-start nil)) (if (not (numberp exit-status)) (error "%s: external command failed: %s" command exit-status)) @@ -540,7 +551,11 @@ See the variable `eshell-kill-processes-on-exit'." (defun eshell-send-eof-to-process () "Send EOF to process." (interactive) + (require 'esh-mode) + (declare-function eshell-send-input "esh-mode" + (&optional use-region queue-p no-newline)) (eshell-send-input nil nil t) (eshell-process-interact 'process-send-eof)) +(provide 'esh-proc) ;;; esh-proc.el ends here diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index d8be72e3596..82e0f7135ba 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -105,11 +105,12 @@ ;;; Code: -(provide 'esh-var) - (require 'esh-util) (require 'esh-cmd) (require 'esh-opt) +(require 'esh-module) +(require 'esh-arg) +(require 'esh-io) (require 'pcomplete) (require 'env) @@ -206,6 +207,9 @@ function), and the arguments passed to this function would be the list (set (make-local-variable 'process-environment) (eshell-copy-environment))) + ;; This is supposedly run after enabling esh-mode, when eshell-command-map + ;; already exists. + (defvar eshell-command-map) (define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar) (set (make-local-variable 'eshell-special-chars-inside-quoting) @@ -213,16 +217,16 @@ function), and the arguments passed to this function would be the list (set (make-local-variable 'eshell-special-chars-outside-quoting) (append eshell-special-chars-outside-quoting '(?$))) - (add-hook 'eshell-parse-argument-hook 'eshell-interpolate-variable t t) + (add-hook 'eshell-parse-argument-hook #'eshell-interpolate-variable t t) (add-hook 'eshell-prepare-command-hook - 'eshell-handle-local-variables nil t) + #'eshell-handle-local-variables nil t) (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook - 'eshell-complete-variable-reference nil t) + #'eshell-complete-variable-reference nil t) (add-hook 'pcomplete-try-first-hook - 'eshell-complete-variable-assignment nil t))) + #'eshell-complete-variable-assignment nil t))) (defun eshell-handle-local-variables () "Allow for the syntax `VAR=val '." @@ -532,7 +536,7 @@ For example, to retrieve the second element of a user's record in (setq separator (caar indices) refs (cdr refs))) (setq value - (mapcar 'eshell-convert + (mapcar #'eshell-convert (split-string value separator))))) (cond ((< (length refs) 0) @@ -618,4 +622,5 @@ For example, to retrieve the second element of a user's record in (setq pcomplete-stub (substring arg pos)) (throw 'pcomplete-completions (pcomplete-entries))))) +(provide 'esh-var) ;;; esh-var.el ends here diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index c7ed7103e40..db20f7d9ec5 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -175,10 +175,10 @@ (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) +(require 'esh-module) ;For eshell-using-module +(require 'esh-proc) ;For eshell-wait-for-process +(require 'esh-io) ;For eshell-last-command-status +(require 'esh-cmd) (defgroup eshell nil "Command shell implemented entirely in Emacs Lisp. @@ -220,12 +220,6 @@ shells such as bash, zsh, rc, 4dos." :type 'string :group 'eshell) -(defcustom eshell-directory-name - (locate-user-emacs-file "eshell/" ".eshell/") - "The directory where Eshell control files should be kept." - :type 'directory - :group 'eshell) - ;;;_* Running Eshell ;; ;; There are only three commands used to invoke Eshell. The first two @@ -259,11 +253,12 @@ buffer selected (or created)." buf)) (defun eshell-return-exits-minibuffer () + ;; This is supposedly run after enabling esh-mode, when eshell-mode-map + ;; already exists. + (defvar eshell-mode-map) (define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit) - (define-key eshell-mode-map [return] 'exit-minibuffer) (define-key eshell-mode-map [(control ?m)] 'exit-minibuffer) (define-key eshell-mode-map [(control ?j)] 'exit-minibuffer) - (define-key eshell-mode-map [(meta return)] 'exit-minibuffer) (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer)) (defvar eshell-non-interactive-p nil @@ -278,7 +273,6 @@ non-interactive sessions, such as when using `eshell-command'.") "Execute the Eshell command string COMMAND. With prefix ARG, insert output into the current buffer at point." (interactive) - (require 'esh-cmd) (unless arg (setq arg current-prefix-arg)) (let ((eshell-non-interactive-p t)) @@ -366,7 +360,8 @@ corresponding to a successful execution." (let ((result (eshell-do-eval (list 'eshell-commands (list 'eshell-command-to-value - (eshell-parse-command command))) t))) + (eshell-parse-command command))) + t))) (cl-assert (eq (car result) 'quote)) (if (and status-var (symbolp status-var)) (set status-var eshell-last-command-status)) @@ -406,4 +401,5 @@ Emacs." (run-hooks 'eshell-load-hook) +(provide 'eshell) ;;; eshell.el ends here From baaacd92fff4e6a49bbb1fea3caed25004490559 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Apr 2019 15:36:18 -0400 Subject: [PATCH 050/121] * nadvice.el: Add ourselves to package--builtin-versions --- lisp/emacs-lisp/nadvice.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index bb647b012e1..2278e389cef 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -36,6 +36,11 @@ ;;; Code: +;; The autoloads.el mechanism which adds package--builtin-versions +;; maintenance to loaddefs.el doesn't work for preloaded packages (such +;; as this one), so we have to do it by hand! +(push (purecopy '(nadvice 1 0)) package--builtin-versions) + ;;;; Lightweight advice/hook (defvar advice--where-alist '((:around "\300\301\302\003#\207" 5) @@ -241,6 +246,8 @@ different, but `function-equal' will hopefully ignore those differences.") (if (local-variable-p var) (symbol-value var) (setq advice--buffer-local-function-sample ;; This function acts like the t special value in buffer-local hooks. + ;; FIXME: Provide an `advice-bottom' function that's like + ;; `advice-cd*r' but also follows through this proxy. (lambda (&rest args) (apply (default-value var) args))))) (eval-and-compile From 31e9087cdcd0b78b2247c3d8532290881abfbb08 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Apr 2019 15:43:26 -0400 Subject: [PATCH 051/121] * lisp/gnus/gnus-agent.el (gnus-agent-fetch-articles): Use match-string (gnus-agent-expire-group-1): Dial down on the 'setq'. --- lisp/gnus/gnus-agent.el | 85 ++++++++++++++++++++--------------------- 1 file changed, 42 insertions(+), 43 deletions(-) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 879e1fe2052..9f7d2c9df7d 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -276,7 +276,7 @@ Actually a hash table holding subjects mapped to t.") (defmacro gnus-agent-with-refreshed-group (group &rest body) "Performs the body then updates the group's line in the group buffer. Automatically blocks multiple updates due to recursion." -`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body) + `(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body) (when (and gnus-agent-need-update-total-fetched-for (not gnus-agent-inhibit-update-total-fetched-for)) (with-current-buffer gnus-group-buffer @@ -311,9 +311,10 @@ buffer. Automatically blocks multiple updates due to recursion." (defun gnus-agent-cat-set-property (category property value) (if value (setcdr (or (assq property category) - (let ((cell (cons property nil))) + (let ((cell (cons property nil))) (setcdr category (cons cell (cdr category))) - cell)) value) + cell)) + value) (let ((category category)) (while (cond ((eq property (caadr category)) (setcdr category (cddr category)) @@ -378,7 +379,8 @@ manipulated as follows: (setcdr (or (assq 'agent-groups category) (let ((cell (cons 'agent-groups nil))) (setcdr category (cons cell (cdr category))) - cell)) new-g)) + cell)) + new-g)) (t (let ((groups groups)) (while groups @@ -395,7 +397,8 @@ manipulated as follows: (setcdr (or (assq 'agent-groups category) (let ((cell (cons 'agent-groups nil))) (setcdr category (cons cell (cdr category))) - cell)) groups)))))) + cell)) + groups)))))) (defsubst gnus-agent-cat-make (name &optional default-agent-predicate) (list name `(agent-predicate . ,(or default-agent-predicate 'false)))) @@ -1557,11 +1560,8 @@ downloaded into the agent." (skip-chars-forward " ") (setq crosses nil) (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *") - (push (cons (buffer-substring (match-beginning 1) - (match-end 1)) - (string-to-number - (buffer-substring (match-beginning 2) - (match-end 2)))) + (push (cons (match-string 1) + (string-to-number (match-string 2))) crosses) (goto-char (match-end 0))) (gnus-agent-crosspost crosses (caar pos) date))) @@ -2939,7 +2939,7 @@ The following commands are available: 'or) ((memq (car predicate) gnus-category-not) 'not)) - ,@(mapcar 'gnus-category-make-function-1 (cdr predicate)))) + ,@(mapcar #'gnus-category-make-function-1 (cdr predicate)))) (t (error "Unknown predicate type: %s" predicate)))) @@ -2965,7 +2965,7 @@ return read articles, nil when it is known to always return read articles, and t_nil when the function may return both read and unread articles." (let ((func (car function)) - (args (mapcar 'gnus-function-implies-unread-1 (cdr function)))) + (args (mapcar #'gnus-function-implies-unread-1 (cdr function)))) (cond ((eq func 'and) (cond ((memq t args) ; if any argument returns only unread articles ;; then that argument constrains the result to only unread articles. @@ -3151,38 +3151,37 @@ FORCE is equivalent to setting the expiration predicates to true." (nov-file (concat dir ".overview")) (cnt 0) (completed -1) - dlist - type) + type - ;; The normal article alist contains elements that look like - ;; (article# . fetch_date) I need to combine other - ;; information with this list. For example, a flag indicating - ;; that a particular article MUST BE KEPT. To do this, I'm - ;; going to transform the elements to look like (article# - ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse - ;; the process to generate the expired article alist. + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse + ;; the process to generate the expired article alist. + (dlist + (nconc + ;; Convert the alist elements to (article# fetch_date nil nil). + (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) + alist) - ;; Convert the alist elements to (article# fetch_date nil - ;; nil). - (setq dlist (mapcar (lambda (e) - (list (car e) (cdr e) nil nil)) alist)) + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precedence of the + ;; keep_flag. + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads) - ;; Convert the keep lists to elements that look like (article# - ;; nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precedence of the - ;; keep_flag. - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'unread nil)) - unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'marked nil)) - marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'special nil)) - specials))) + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked) + + (mapcar (lambda (e) + (list e nil 'special nil)) + specials)))) (set-buffer overview) (erase-buffer) @@ -3391,7 +3390,7 @@ article alist" type) actions)) (when actions (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" decoded article-number - (mapconcat 'identity actions ", "))))) + (mapconcat #'identity actions ", "))))) (t (gnus-agent-message 10 "gnus-agent-expire: %s:%d: Article kept as \ @@ -3624,7 +3623,7 @@ If CACHED-HEADER is nil, articles are only excluded if the article itself has been fetched." ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar - ;; 'car gnus-agent-article-alist)) + ;; #'car gnus-agent-article-alist)) ;; Functionally, I don't need to construct a temp list using mapcar. From a038df77de7b1aa2d73a6478493b8838b59e4982 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 8 Apr 2019 12:59:22 -0700 Subject: [PATCH 052/121] Allow gap before first non-Lisp pseudovec member Problem reported by Keith David Bershatsky in: https://lists.gnu.org/r/emacs-devel/2019-04/msg00259.html Solution suggested by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2019-04/msg00282.html * src/buffer.h (BUFFER_LISP_SIZE): Simplify by using PSEUDOVECSIZE. (BUFFER_REST_SIZE): Simplify by using VECSIZE and BUFFER_LISP_SIZE. * src/lisp.h (PSEUDOVECSIZE): Base it on the last Lisp field, not the first non-Lisp field. All callers changed. Callers without Lisp fields changed to use ALLOCATE_PLAIN_PSEUDOVECTOR. (ALLOCATE_PLAIN_PSEUDOVECTOR): New macro. --- src/alloc.c | 20 ++++++++++---------- src/bignum.c | 8 ++++---- src/buffer.h | 14 ++++++-------- src/emacs-module.c | 2 +- src/fns.c | 2 +- src/frame.c | 3 ++- src/frame.h | 7 +++---- src/lisp.h | 24 ++++++++++++++++-------- src/pdumper.c | 4 ++-- src/process.c | 3 ++- src/process.h | 4 +--- src/termhooks.h | 2 +- src/terminal.c | 4 ++-- src/thread.c | 8 ++++---- src/thread.h | 2 +- src/w32term.c | 2 +- src/window.c | 23 ++++++++++------------- src/window.h | 5 ++--- src/xterm.c | 4 ++-- src/xterm.h | 2 +- src/xwidget.c | 5 ++--- src/xwidget.h | 6 ++---- 22 files changed, 76 insertions(+), 78 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index e48807c49ad..dd783863be8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3718,8 +3718,8 @@ Its value is void, and its function definition and property list are nil. */) Lisp_Object make_misc_ptr (void *a) { - struct Lisp_Misc_Ptr *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Misc_Ptr, pointer, - PVEC_MISC_PTR); + struct Lisp_Misc_Ptr *p = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Misc_Ptr, + PVEC_MISC_PTR); p->pointer = a; return make_lisp_ptr (p, Lisp_Vectorlike); } @@ -3729,7 +3729,7 @@ make_misc_ptr (void *a) Lisp_Object build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist) { - struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, next, + struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, plist, PVEC_OVERLAY); Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike); OVERLAY_START (overlay) = start; @@ -3743,8 +3743,8 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, doc: /* Return a newly allocated marker which does not point at any place. */) (void) { - struct Lisp_Marker *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, - PVEC_MARKER); + struct Lisp_Marker *p = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker, + PVEC_MARKER); p->buffer = 0; p->bytepos = 0; p->charpos = 0; @@ -3766,8 +3766,8 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) /* Every character is at least one byte. */ eassert (charpos <= bytepos); - struct Lisp_Marker *m = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, - PVEC_MARKER); + struct Lisp_Marker *m = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker, + PVEC_MARKER); m->buffer = buf; m->charpos = charpos; m->bytepos = bytepos; @@ -3821,8 +3821,8 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p) { - struct Lisp_User_Ptr *uptr = ALLOCATE_PSEUDOVECTOR (struct Lisp_User_Ptr, - finalizer, PVEC_USER_PTR); + struct Lisp_User_Ptr *uptr + = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_User_Ptr, PVEC_USER_PTR); uptr->finalizer = finalizer; uptr->p = p; return make_lisp_ptr (uptr, Lisp_Vectorlike); @@ -3945,7 +3945,7 @@ FUNCTION. FUNCTION will be run once per finalizer object. */) (Lisp_Object function) { struct Lisp_Finalizer *finalizer - = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, prev, PVEC_FINALIZER); + = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, function, PVEC_FINALIZER); finalizer->function = function; finalizer->prev = finalizer->next = NULL; finalizer_insert (&finalizers, finalizer); diff --git a/src/bignum.c b/src/bignum.c index 4118601e108..009d73118c2 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -86,8 +86,8 @@ make_bignum_bits (size_t bits) if (integer_width < bits) overflow_error (); - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); + struct Lisp_Bignum *b = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Bignum, + PVEC_BIGNUM); mpz_init (b->value); mpz_swap (b->value, mpz[0]); return make_lisp_ptr (b, Lisp_Vectorlike); @@ -342,8 +342,8 @@ bignum_to_string (Lisp_Object num, int base) Lisp_Object make_bignum_str (char const *num, int base) { - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); + struct Lisp_Bignum *b = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Bignum, + PVEC_BIGNUM); mpz_init (b->value); int check = mpz_set_str (b->value, num, base); eassert (check == 0); diff --git a/src/buffer.h b/src/buffer.h index 63b162161c6..f42c3e97b97 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -741,8 +741,8 @@ struct buffer See `cursor-type' for other values. */ Lisp_Object cursor_in_non_selected_windows_; - /* No more Lisp_Object beyond this point. Except undo_list, - which is handled specially in Fgarbage_collect. */ + /* No more Lisp_Object beyond cursor_in_non_selected_windows_. + Except undo_list, which is handled specially in Fgarbage_collect. */ /* This structure holds the coordinates of the buffer contents in ordinary buffers. In indirect buffers, this is not used. */ @@ -1019,14 +1019,12 @@ bset_width_table (struct buffer *b, Lisp_Object val) structure, make sure that this is still correct. */ #define BUFFER_LISP_SIZE \ - ((offsetof (struct buffer, own_text) - header_size) / word_size) + PSEUDOVECSIZE (struct buffer, cursor_in_non_selected_windows_) -/* Size of the struct buffer part beyond leading Lisp_Objects, in word_size - units. Rounding is needed for --with-wide-int configuration. */ +/* Allocated size of the struct buffer part beyond leading + Lisp_Objects, in word_size units. */ -#define BUFFER_REST_SIZE \ - ((((sizeof (struct buffer) - offsetof (struct buffer, own_text)) \ - + (word_size - 1)) & ~(word_size - 1)) / word_size) +#define BUFFER_REST_SIZE (VECSIZE (struct buffer) - BUFFER_LISP_SIZE) /* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE is required for GC, but BUFFER_REST_SIZE is set up just to be consistent diff --git a/src/emacs-module.c b/src/emacs-module.c index 2bb1062574e..47ca3368c0f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -427,7 +427,7 @@ static struct Lisp_Module_Function * allocate_module_function (void) { return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function, - min_arity, PVEC_MODULE_FUNCTION); + documentation, PVEC_MODULE_FUNCTION); } #define XSET_MODULE_FUNCTION(var, ptr) \ diff --git a/src/fns.c b/src/fns.c index b97b132b0fe..c3202495daf 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3904,7 +3904,7 @@ static struct Lisp_Hash_Table * allocate_hash_table (void) { return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, - count, PVEC_HASH_TABLE); + index, PVEC_HASH_TABLE); } /* An upper bound on the size of a hash table index. It must fit in diff --git a/src/frame.c b/src/frame.c index 6fdb7d0cbb9..192ef4244fb 100644 --- a/src/frame.c +++ b/src/frame.c @@ -798,7 +798,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, static struct frame * allocate_frame (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct frame, tool_bar_items, + PVEC_FRAME); } struct frame * diff --git a/src/frame.h b/src/frame.h index ed62e7ace0f..ec8f61465f2 100644 --- a/src/frame.h +++ b/src/frame.h @@ -190,9 +190,6 @@ struct frame Lisp_Object current_tool_bar_string; #endif - /* Desired and current tool-bar items. */ - Lisp_Object tool_bar_items; - #ifdef USE_GTK /* Where tool bar is, can be left, right, top or bottom. Except with GTK, the only supported position is `top'. */ @@ -204,7 +201,9 @@ struct frame Lisp_Object font_data; #endif - /* Beyond here, there should be no more Lisp_Object components. */ + /* Desired and current tool-bar items. */ + Lisp_Object tool_bar_items; + /* tool_bar_items should be the last Lisp_Object member. */ /* Cache of realized faces. */ struct face_cache *face_cache; diff --git a/src/lisp.h b/src/lisp.h index a0a7cbdf518..681efc3b52b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1904,9 +1904,9 @@ memclear (void *p, ptrdiff_t nbytes) at the end and we need to compute the number of Lisp_Object fields (the ones that the GC needs to trace). */ -#define PSEUDOVECSIZE(type, nonlispfield) \ - (offsetof (type, nonlispfield) < header_size \ - ? 0 : (offsetof (type, nonlispfield) - header_size) / word_size) +#define PSEUDOVECSIZE(type, lastlispfield) \ + (offsetof (type, lastlispfield) + word_size < header_size \ + ? 0 : (offsetof (type, lastlispfield) + word_size - header_size) / word_size) /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as @@ -2109,11 +2109,14 @@ enum char_table_specials /* This is the number of slots that every char table must have. This counts the ordinary slots and the top, defalt, parent, and purpose slots. */ - CHAR_TABLE_STANDARD_SLOTS = PSEUDOVECSIZE (struct Lisp_Char_Table, extras), + CHAR_TABLE_STANDARD_SLOTS + = (PSEUDOVECSIZE (struct Lisp_Char_Table, contents) - 1 + + (1 << CHARTAB_SIZE_BITS_0)), - /* This is an index of first Lisp_Object field in Lisp_Sub_Char_Table + /* This is the index of the first Lisp_Object field in Lisp_Sub_Char_Table when the latter is treated as an ordinary Lisp_Vector. */ - SUB_CHAR_TABLE_OFFSET = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) + SUB_CHAR_TABLE_OFFSET + = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) - 1 }; /* Sanity-check pseudovector layout. */ @@ -2313,8 +2316,8 @@ struct Lisp_Hash_Table hash table size to reduce collisions. */ Lisp_Object index; - /* Only the fields above are traced normally by the GC. The ones below - `count' are special and are either ignored by the GC or traced in + /* Only the fields above are traced normally by the GC. The ones after + 'index' are special and are either ignored by the GC or traced in a special way (e.g. because of weakness). */ /* Number of key/value entries in the table. */ @@ -3940,6 +3943,11 @@ make_nil_vector (ptrdiff_t size) extern struct Lisp_Vector *allocate_pseudovector (int, int, int, enum pvec_type); +/* Allocate uninitialized pseudovector with no Lisp_Object slots. */ + +#define ALLOCATE_PLAIN_PSEUDOVECTOR(type, tag) \ + ((type *) allocate_pseudovector (VECSIZE (type), 0, 0, tag)) + /* Allocate partially initialized pseudovector where all Lisp_Object slots are set to Qnil but the rest (if any) is left uninitialized. */ diff --git a/src/pdumper.c b/src/pdumper.c index b19f206d1bd..cb2915cb203 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2702,7 +2702,7 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Hash_Table_73C9BFB7D1) +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_EF95ED06FF # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); @@ -2770,7 +2770,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_2CEE653E74 +#if CHECK_STRUCTS && !defined HASH_buffer_E34A11C6B9 # error "buffer changed. See CHECK_STRUCTS comment." #endif struct buffer munged_buffer = *in_buffer; diff --git a/src/process.c b/src/process.c index 802ac026249..6770a5ed884 100644 --- a/src/process.c +++ b/src/process.c @@ -858,7 +858,8 @@ allocate_pty (char pty_name[PTY_NAME_SIZE]) static struct Lisp_Process * allocate_process (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, thread, + PVEC_PROCESS); } static Lisp_Object diff --git a/src/process.h b/src/process.h index d66aa062a54..5e957c4298e 100644 --- a/src/process.h +++ b/src/process.h @@ -117,9 +117,7 @@ struct Lisp_Process /* The thread a process is linked to, or nil for any thread. */ Lisp_Object thread; - - /* After this point, there are no Lisp_Objects any more. */ - /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ + /* After this point, there are no Lisp_Objects. */ /* Process ID. A positive value is a child process ID. Zero is for pseudo-processes such as network or serial connections, diff --git a/src/termhooks.h b/src/termhooks.h index ca6782f461b..a92b981110d 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -408,7 +408,7 @@ struct terminal whether the mapping is available. */ Lisp_Object glyph_code_table; - /* All fields before `next_terminal' should be Lisp_Object and are traced + /* All earlier fields should be Lisp_Objects and are traced by the GC. All fields afterwards are ignored by the GC. */ /* Chain of all terminal devices. */ diff --git a/src/terminal.c b/src/terminal.c index 1d7a965dd26..0ee0121e35e 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -264,8 +264,8 @@ get_named_terminal (const char *name) static struct terminal * allocate_terminal (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR - (struct terminal, next_terminal, PVEC_TERMINAL); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct terminal, glyph_code_table, + PVEC_TERMINAL); } /* Create a new terminal object of TYPE and add it to the terminal list. RIF diff --git a/src/thread.c b/src/thread.c index e51d6144347..670680f2b0d 100644 --- a/src/thread.c +++ b/src/thread.c @@ -267,7 +267,7 @@ informational only. */) if (!NILP (name)) CHECK_STRING (name); - mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX); + mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, name, PVEC_MUTEX); memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex), 0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex, mutex)); @@ -386,7 +386,7 @@ informational only. */) if (!NILP (name)) CHECK_STRING (name); - condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR); + condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, name, PVEC_CONDVAR); memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond), 0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar, cond)); @@ -805,7 +805,7 @@ If NAME is given, it must be a string; it names the new thread. */) if (!NILP (name)) CHECK_STRING (name); - new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_stack_bottom, + new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, event_object, PVEC_THREAD); memset ((char *) new_thread + offset, 0, sizeof (struct thread_state) - offset); @@ -1064,7 +1064,7 @@ static void init_main_thread (void) { main_thread.s.header.size - = PSEUDOVECSIZE (struct thread_state, m_stack_bottom); + = PSEUDOVECSIZE (struct thread_state, event_object); XSETPVECTYPE (&main_thread.s, PVEC_THREAD); main_thread.s.m_last_thing_searched = Qnil; main_thread.s.m_saved_last_thing_searched = Qnil; diff --git a/src/thread.h b/src/thread.h index 50f8f5cbe0a..0514669a87d 100644 --- a/src/thread.h +++ b/src/thread.h @@ -61,8 +61,8 @@ struct thread_state /* If we are waiting for some event, this holds the object we are waiting on. */ Lisp_Object event_object; + /* event_object must be the last Lisp field. */ - /* m_stack_bottom must be the first non-Lisp field. */ /* An address near the bottom of the stack. Tells GC how to save a copy of the stack. */ char const *m_stack_bottom; diff --git a/src/w32term.c b/src/w32term.c index 7dbeda7a716..bb1f0bad018 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -3896,7 +3896,7 @@ x_scroll_bar_create (struct window *w, int left, int top, int width, int height, HWND hwnd; SCROLLINFO si; struct scroll_bar *bar - = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, top, PVEC_OTHER); + = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, w32_widget_high, PVEC_OTHER); Lisp_Object barobj; block_input (); diff --git a/src/window.c b/src/window.c index be338c2af61..f911c0c7d44 100644 --- a/src/window.c +++ b/src/window.c @@ -4170,8 +4170,8 @@ temp_output_buffer_show (register Lisp_Object buf) static struct window * allocate_window (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR - (struct window, current_matrix, PVEC_WINDOW); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct window, mode_line_help_echo, + PVEC_WINDOW); } /* Make new window, have it replace WINDOW in window-tree, and make @@ -6710,7 +6710,8 @@ struct save_window_data Lisp_Object saved_windows; /* All fields above are traced by the GC. - From `frame-cols' down, the fields are ignored by the GC. */ + After saved_windows, the fields are ignored by the GC. */ + /* We should be able to do without the following two. */ int frame_cols, frame_lines; /* These two should get eventually replaced by their pixel @@ -7383,15 +7384,11 @@ redirection (see `redirect-frame-focus'). The variable saved by this function. */) (Lisp_Object frame) { - Lisp_Object tem; - ptrdiff_t i, n_windows; - struct save_window_data *data; struct frame *f = decode_live_frame (frame); - - n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f))); - data = ALLOCATE_PSEUDOVECTOR (struct save_window_data, frame_cols, - PVEC_WINDOW_CONFIGURATION); - + ptrdiff_t n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f))); + struct save_window_data *data + = ALLOCATE_PSEUDOVECTOR (struct save_window_data, saved_windows, + PVEC_WINDOW_CONFIGURATION); data->frame_cols = FRAME_COLS (f); data->frame_lines = FRAME_LINES (f); data->frame_menu_bar_lines = FRAME_MENU_BAR_LINES (f); @@ -7407,9 +7404,9 @@ saved by this function. */) data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil; data->root_window = FRAME_ROOT_WINDOW (f); data->focus_frame = FRAME_FOCUS_FRAME (f); - tem = make_uninit_vector (n_windows); + Lisp_Object tem = make_uninit_vector (n_windows); data->saved_windows = tem; - for (i = 0; i < n_windows; i++) + for (ptrdiff_t i = 0; i < n_windows; i++) ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window))); save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0); XSETWINDOW_CONFIGURATION (tem, data); diff --git a/src/window.h b/src/window.h index 4235a6eade2..fdef407041b 100644 --- a/src/window.h +++ b/src/window.h @@ -212,9 +212,8 @@ struct window /* The help echo text for this window. Qnil if there's none. */ Lisp_Object mode_line_help_echo; - /* No Lisp data may follow below this point without changing - mark_object in alloc.c. The member current_matrix must be the - first non-Lisp member. */ + /* No Lisp data may follow this point; mode_line_help_echo must be + the last Lisp member. */ /* Glyph matrices. */ struct glyph_matrix *current_matrix; diff --git a/src/xterm.c b/src/xterm.c index 2f830afe61b..5aa3e3ff25c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6611,8 +6611,8 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height, bool horizontal) { struct frame *f = XFRAME (w->frame); - struct scroll_bar *bar - = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, x_window, PVEC_OTHER); + struct scroll_bar *bar = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, + PVEC_OTHER); Lisp_Object barobj; block_input (); diff --git a/src/xterm.h b/src/xterm.h index 972a10f4d41..c5ad38650c2 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -897,7 +897,7 @@ struct scroll_bar /* The next and previous in the chain of scroll bars in this frame. */ Lisp_Object next, prev; - /* Fields from `x_window' down will not be traced by the GC. */ + /* Fields after 'prev' are not traced by the GC. */ /* The X window representing this scroll bar. */ Window x_window; diff --git a/src/xwidget.c b/src/xwidget.c index c56284928e3..2486a2d4da8 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -41,14 +41,13 @@ along with GNU Emacs. If not, see . */ static struct xwidget * allocate_xwidget (void) { - return ALLOCATE_PSEUDOVECTOR (struct xwidget, height, PVEC_XWIDGET); + return ALLOCATE_PSEUDOVECTOR (struct xwidget, script_callbacks, PVEC_XWIDGET); } static struct xwidget_view * allocate_xwidget_view (void) { - return ALLOCATE_PSEUDOVECTOR (struct xwidget_view, redisplayed, - PVEC_XWIDGET_VIEW); + return ALLOCATE_PSEUDOVECTOR (struct xwidget_view, w, PVEC_XWIDGET_VIEW); } #define XSETXWIDGET(a, b) XSETPSEUDOVECTOR (a, b, PVEC_XWIDGET) diff --git a/src/xwidget.h b/src/xwidget.h index 8c598efb2e2..1b6368daabf 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -49,8 +49,7 @@ struct xwidget /* Vector of currently executing scripts with callbacks. */ Lisp_Object script_callbacks; - - /* Here ends the Lisp part. "height" is the marker field. */ + /* Here ends the Lisp part. script_callbacks is the marker field. */ int height; int width; @@ -68,8 +67,7 @@ struct xwidget_view union vectorlike_header header; Lisp_Object model; Lisp_Object w; - - /* Here ends the lisp part. "redisplayed" is the marker field. */ + /* Here ends the lisp part. "w" is the marker field. */ /* If touched by redisplay. */ bool redisplayed; From 0667c73708e3c8ed886a4ab0c220fd13908059e5 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 8 Apr 2019 23:34:20 +0300 Subject: [PATCH 053/121] * lisp/vc/diff-mode.el (diff-syntax-fontify-props): Check both buffer-local and default value of find-file-hook. --- lisp/vc/diff-mode.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index dbde284da84..840f2c67d20 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2529,7 +2529,8 @@ hunk text is not found in the source file." (let ((enable-local-variables :safe) ;; to find `mode:' (buffer-file-name file)) (set-auto-mode) - (when (and (memq 'generic-mode-find-file-hook find-file-hook) + (when (and (memq 'generic-mode-find-file-hook + (append find-file-hook (default-value 'find-file-hook))) (fboundp 'generic-mode-find-file-hook)) (generic-mode-find-file-hook)))) From 36dc39bfbf1a307769bd62dbe1311a1935737b51 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 8 Apr 2019 16:49:11 -0400 Subject: [PATCH 054/121] * lisp/gnus/gnus-sum.el: Prepare for lexical-binding Add defvars for all the gnus-tmp-*. (gnus-summary-make-local-variables): Move let binding to avoid setq. (gnus-set-global-variables): Use dolist. (gnus-summary-from-or-to-or-newsgroups, gnus-summary-insert-line) (gnus-summary-insert-dummy-line): Avoid dynbind args. (gnus-build-old-threads): Remove unused var 'id'. (gnus-nov-parse-line): Remove unused var 'buffer'. (gnus-thread-header): Prepare it for a lexbind world. (gnus-adjust-marked-articles): Remove unused var 'marks'. (gnus-mark-xrefs-as-read): Remove unused var 'idlist'. (gnus-summary-display-article): Erase&widen before mm-enable-multibyte. (gnus-summary-better-unread-subject): Remove unused var 'score'. (gnus-summary-find-matching): Remove unused var 'd'. (ps-right-header, ps-left-header, shr-ignore-cache): Declare vars. (gnus-summary-idna-message, gnus-summary-morse-message) (gnus-summary-sort-by-original): Fix interactive spec since we don't actually use any prefix arg. (gnus-summary-move-article, gnus-read-move-group-name): Use user-error. (gnus-summary-move-article): Use dolist. (gnus-summary-edit-article): Fix unquoting. (gnus-summary-highlight-line-0, gnus-summary-highlight-line): Declare dynbind vars documented in gnus-summary-highlight. --- lisp/gnus/gnus-sum.el | 229 +++++++++++++++++++++++++++--------------- 1 file changed, 147 insertions(+), 82 deletions(-) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 21f0e5951cc..fd72e1d3abb 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -27,7 +27,34 @@ (require 'cl-lib) (defvar tool-bar-mode) +(defvar gnus-category-predicate-alist) +(defvar gnus-category-predicate-cache) +(defvar gnus-inhibit-article-treatments) +(defvar gnus-inhibit-demon) +(defvar gnus-tmp-article-number) +(defvar gnus-tmp-closing-bracket) +(defvar gnus-tmp-current) +(defvar gnus-tmp-dummy) +(defvar gnus-tmp-expirable) +(defvar gnus-tmp-from) +(defvar gnus-tmp-group-name) (defvar gnus-tmp-header) +(defvar gnus-tmp-indentation) +(defvar gnus-tmp-level) +(defvar gnus-tmp-lines) +(defvar gnus-tmp-number) +(defvar gnus-tmp-opening-bracket) +(defvar gnus-tmp-process) +(defvar gnus-tmp-replied) +(defvar gnus-tmp-score) +(defvar gnus-tmp-score-char) +(defvar gnus-tmp-subject) +(defvar gnus-tmp-subject-or-nil) +(defvar gnus-tmp-unread) +(defvar gnus-tmp-unread-and-unselected) +(defvar gnus-tmp-unread-and-unticked) +(defvar gnus-tmp-user-defined) +(defvar gnus-use-article-prefetch) (require 'gnus) (require 'gnus-group) @@ -784,7 +811,7 @@ score file." :group 'gnus-score-default :type 'integer) -(defun gnus-widget-reversible-match (widget value) +(defun gnus-widget-reversible-match (_widget value) "Ignoring WIDGET, convert VALUE to internal form. VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol." ;; (debug value) @@ -794,7 +821,7 @@ VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol." (eq (nth 0 value) 'not) (symbolp (nth 1 value))))) -(defun gnus-widget-reversible-to-internal (widget value) +(defun gnus-widget-reversible-to-internal (_widget value) "Ignoring WIDGET, convert VALUE to internal form. VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom. FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)." @@ -803,7 +830,7 @@ FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)." (list value nil) (list (nth 1 value) t))) -(defun gnus-widget-reversible-to-external (widget value) +(defun gnus-widget-reversible-to-external (_widget value) "Ignoring WIDGET, convert VALUE to external form. VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom. \(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)." @@ -1385,7 +1412,8 @@ the normal Gnus MIME machinery." (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) ?s) (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) - gnus-tmp-from) ?s) + gnus-tmp-from) + ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) @@ -1397,12 +1425,15 @@ the normal Gnus MIME machinery." (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) (?L gnus-tmp-lines ?s) (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header)) - 0) ?d) + 0) + ?d) (?G (or (nnir-article-group (mail-header-number gnus-tmp-header)) - "") ?s) + "") + ?s) (?g (or (gnus-group-short-name (nnir-article-group (mail-header-number gnus-tmp-header))) - "") ?s) + "") + ?s) (?O gnus-tmp-downloaded ?c) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) @@ -1427,7 +1458,8 @@ the normal Gnus MIME machinery." (?P (gnus-pick-line-number) ?d) (?B gnus-tmp-thread-tree-header-string ?s) (user-date (gnus-user-date - ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s)) + ,(macroexpand '(mail-header-date gnus-tmp-header))) + ?s)) "An alist of format specifications that can appear in summary lines. These are paired with what variables they correspond with, along with the type of the variable (string, integer, character, etc).") @@ -1672,6 +1704,7 @@ For example: (eval-when-compile ;; Bind features so that require will believe that gnus-sum has ;; already been loaded (avoids infinite recursion) + (with-no-warnings (defvar features)) ;Not just a local variable. (let ((features (cons 'gnus-sum features))) (require 'gnus-art))) @@ -3107,18 +3140,16 @@ The following commands are available: (defun gnus-summary-make-local-variables () "Make all the local summary buffer variables." - (let (global) - (dolist (local gnus-summary-local-variables) - (if (consp local) - (progn - (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (setq global (symbol-value (car local))) - ;; Use the value from the list. - (setq global (eval (cdr local)))) - (set (make-local-variable (car local)) global)) - ;; Simple nil-valued local variable. - (set (make-local-variable local) nil))))) + (dolist (local gnus-summary-local-variables) + (if (consp local) + (let ((global (if (eq (cdr local) 'global) + ;; Copy the global value of the variable. + (symbol-value (car local)) + ;; Use the value from the list. + (eval (cdr local))))) + (set (make-local-variable (car local)) global)) + ;; Simple nil-valued local variable. + (set (make-local-variable local) nil)))) ;; Summary data functions. @@ -3525,13 +3556,12 @@ buffer that was in action when the last article was fetched." (score-file gnus-current-score-file) (default-charset gnus-newsgroup-charset) vlist) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (push (eval (caar locals)) vlist) - (push (eval (car locals)) vlist)) - (setq locals (cdr locals))) - (setq vlist (nreverse vlist))) + (dolist (local gnus-newsgroup-variables) + (push (eval (if (consp local) (car local) + local) + t) + vlist)) + (setq vlist (nreverse vlist)) (with-temp-buffer (setq gnus-newsgroup-name name gnus-newsgroup-marked marked @@ -3546,12 +3576,11 @@ buffer that was in action when the last article was fetched." gnus-reffed-article-number reffed gnus-current-score-file score-file gnus-newsgroup-charset default-charset) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (set (caar locals) (pop vlist)) - (set (car locals) (pop vlist))) - (setq locals (cdr locals)))))))) + (dolist (local gnus-newsgroup-variables) + (set (if (consp local) + (car local) + local) + (pop vlist))))))) (defun gnus-summary-article-unread-p (article) "Say whether ARTICLE is unread or not." @@ -3639,19 +3668,23 @@ buffer that was in action when the last article was fetched." pos))) (setq gnus-summary-mark-positions pos)))) -(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) +(defun gnus-summary-insert-dummy-line (subject number) "Insert a dummy root in the summary buffer." (beginning-of-line) (add-text-properties - (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) - (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) + (point) (let ((gnus-tmp-subject subject) + (gnus-tmp-number number)) + (eval gnus-summary-dummy-line-format-spec t) + (point)) + (list 'gnus-number number 'gnus-intangible number))) (defun gnus-summary-extract-address-component (from) (or (car (funcall gnus-extract-address-components from)) from)) -(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) - (let ((mail-parse-charset gnus-newsgroup-charset) +(defun gnus-summary-from-or-to-or-newsgroups (header from) + (let ((gnus-tmp-from from) + (mail-parse-charset gnus-newsgroup-charset) ;; Is it really necessary to do this next part for each summary line? ;; Luckily, doesn't seem to slow things down much. (mail-parse-ignored-charsets @@ -3678,25 +3711,31 @@ buffer that was in action when the last article was fetched." (and (memq 'Newsgroups gnus-extra-headers) (eq (car (gnus-find-method-for-group - gnus-newsgroup-name)) 'nntp) + gnus-newsgroup-name)) + 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) (bidi-string-mark-left-to-right (inline (gnus-summary-extract-address-component gnus-tmp-from)))))) -(defun gnus-summary-insert-line (gnus-tmp-header - gnus-tmp-level gnus-tmp-current - undownloaded gnus-tmp-unread gnus-tmp-replied - gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score - gnus-tmp-process) - (if (>= gnus-tmp-level (length gnus-thread-indent-array)) +(defun gnus-summary-insert-line (header level current undownloaded + unread replied expirable subject-or-nil + &optional dummy score process) + (if (>= level (length gnus-thread-indent-array)) (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array)) - gnus-tmp-level))) - (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) + level))) + (let* ((gnus-tmp-header header) + (gnus-tmp-level level) + (gnus-tmp-current current) + (gnus-tmp-unread unread) + (gnus-tmp-expirable expirable) + (gnus-tmp-subject-or-nil subject-or-nil) + (gnus-tmp-dummy dummy) + (gnus-tmp-process process) + (gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) - (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) + (gnus-tmp-score (or score gnus-summary-default-score 0)) (gnus-tmp-score-char (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) @@ -3709,7 +3748,7 @@ buffer that was in action when the last article was fetched." (cond (gnus-tmp-process gnus-process-mark) ((memq gnus-tmp-current gnus-newsgroup-cached) gnus-cached-mark) - (gnus-tmp-replied gnus-replied-mark) + (replied gnus-replied-mark) ((memq gnus-tmp-current gnus-newsgroup-forwarded) gnus-forwarded-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) @@ -4461,7 +4500,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; build complete threads - if the roots haven't been expired by the ;; server, that is. (let ((mail-parse-charset gnus-newsgroup-charset) - id heads) + heads) (maphash (lambda (id refs) (when (not (car refs)) @@ -4485,7 +4524,6 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (point-at-eol)) - (buffer (current-buffer)) header references in-reply-to) ;; overview: [num subject from date id refs chars lines misc] @@ -4940,8 +4978,16 @@ Note that THREAD must never, ever be anything else than a variable - using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" - (vector thread) 2)) + (cond + ((and (boundp 'lexical-binding) lexical-binding) + ;; FIXME: This version could be a "defsubst" rather than a macro. + `(#[257 "\211:\203\16\0\211@;\203\15\0A@@\207" + [] 2] + ,thread)) + (t + ;; Not sure how XEmacs handles these things, so let's keep the old code. + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" + (vector thread) 2)))) (defsubst gnus-article-sort-by-number (h1 h2) "Sort articles by article number." @@ -5972,7 +6018,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - marks var articles article mark mark-type + var articles article mark mark-type bgn end) ;; Hack to avoid adjusting marks for imap. (when (eq (car (gnus-find-method-for-group (gnus-info-group info))) @@ -6234,7 +6280,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) "Look through all the headers and mark the Xrefs as read." (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name info xref-hashtb idlist method nth4) + name info xref-hashtb method nth4) (with-current-buffer gnus-group-buffer (when (setq xref-hashtb (gnus-create-xref-hashtb from-newsgroup headers unreads)) @@ -7488,7 +7534,7 @@ The state which existed when entering the ephemeral is reset." (with-current-buffer buffer (gnus-deaden-summary)))))) -(defun gnus-summary-wake-up-the-dead (&rest args) +(defun gnus-summary-wake-up-the-dead (&rest _) "Wake up the dead summary buffer." (interactive) (gnus-dead-summary-mode -1) @@ -7714,6 +7760,12 @@ Given a prefix, will force an `article' buffer configuration." (gnus-article-setup-buffer)) (gnus-set-global-variables) (with-current-buffer gnus-article-buffer + ;; The buffer may be non-empty and even narrowed, so go back to + ;; a sane state. + (widen) + ;; We're going to erase the buffer anyway so do it now: it can save us from + ;; uselessly performing multibyte-conversion of the current content. + (let ((inhibit-read-only t)) (erase-buffer)) (setq gnus-article-charset gnus-newsgroup-charset) (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) (mm-enable-multibyte)) @@ -7857,7 +7909,7 @@ If BACKWARD, the previous article is selected instead of the next." (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward point)))))))) -(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start) +(defun gnus-summary-walk-group-buffer (_from-group cmd unread backward start) (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) (?\C-p (gnus-group-prev-unread-group 1)))) (cursor-in-echo-area t) @@ -8151,7 +8203,7 @@ score higher than the default score." "Select the first unread subject that has a score over the default score." (interactive) (let ((data gnus-newsgroup-data) - article score) + article) (while (and (setq article (gnus-data-number (car data))) (or (gnus-data-read-p (car data)) (not (> (gnus-summary-article-score article) @@ -8564,7 +8616,7 @@ If UNREPLIED (the prefix), limit to unreplied articles." (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) -(defun gnus-summary-limit-exclude-marks (marks &optional reverse) +(defun gnus-summary-limit-exclude-marks (marks &optional _reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are marked with MARKS. MARKS can either be a string of marks or a list of marks. @@ -8866,7 +8918,7 @@ fetch-old-headers verbiage, and so on." (push gnus-newsgroup-limit gnus-newsgroup-limits) (setq gnus-newsgroup-limit nil) (maphash - (lambda (id deps) + (lambda (_id deps) (unless (car deps) ;; These threads have no parents -- they are roots. (let ((nodes (cdr deps)) @@ -9524,6 +9576,9 @@ fetched headers for, whether they are displayed or not." (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search t)) (dolist (header gnus-newsgroup-headers) + ;; FIXME: when called from gnus-summary-limit-include-thread via + ;; gnus-summary-limit-include-matching-articles, `regexp' is a decoded + ;; string whereas the header isn't decoded. (when (string-match regexp (funcall func header)) (push (mail-header-number header) articles))) (nreverse articles))) @@ -9538,7 +9593,7 @@ be taken into consideration. If NOT-CASE-FOLD, case won't be folded in the comparisons. If NOT-MATCHING, return a list of all articles that not match REGEXP on HEADER." (let ((case-fold-search (not not-case-fold)) - articles d func) + articles func) (if (consp header) (if (eq (car header) 'extra) (setq func @@ -9658,6 +9713,10 @@ to save in." (gnus-summary-remove-process-mark article)) (ps-despool filename)) +(defvar ps-right-header) +(defvar ps-left-header) +(defvar shr-ignore-cache) + (defun gnus-print-buffer () (let ((ps-left-header (list @@ -9883,7 +9942,7 @@ prefix specifies how many places to rotate each letter forward." ;; Create buttons and stuff... (gnus-treat-article nil)) -(defun gnus-summary-idna-message (&optional arg) +(defun gnus-summary-idna-message (&optional _arg) "Decode IDNA encoded domain names in the current articles. IDNA encoded domain names looks like `xn--bar'. If a string remain unencoded after running this function, it is likely an @@ -9891,7 +9950,7 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/') installed for this command to work." - (interactive "P") + (interactive) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9903,9 +9962,9 @@ installed for this command to work." (replace-match (puny-decode-domain (match-string 1)))) (set-window-start (get-buffer-window (current-buffer)) start)))))) -(defun gnus-summary-morse-message (&optional arg) +(defun gnus-summary-morse-message (&optional _arg) "Morse decode the current article." - (interactive "P") + (interactive) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9963,11 +10022,11 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (cond ((and (eq action 'move) (not (gnus-check-backend-function 'request-move-article gnus-newsgroup-name))) - (error "The current group does not support article moving")) + (user-error "The current group does not support article moving")) ((and (eq action 'crosspost) (not (gnus-check-backend-function 'request-replace-article gnus-newsgroup-name))) - (error "The current group does not support article editing"))) + (user-error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) (prefix (if (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) @@ -9979,7 +10038,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups + art-group to-method new-xref to-groups articles-to-update-marks encoded) (unless (assq action names) (error "Unknown action %s" action)) @@ -10029,8 +10088,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) - (while articles - (setq article (pop articles)) + (dolist (article articles) ;; Set any marks that may have changed in the summary buffer. (when gnus-preserve-marks (gnus-summary-push-marks-to-backend article)) @@ -10232,7 +10290,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-newsgroup select-method)) - ;;;!!!Why is this necessary? + ;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) (when (eq action 'move) @@ -10598,7 +10656,7 @@ groups." (let ((mbl mml-buffer-list)) (setq mml-buffer-list nil) (let ((rfc2047-quote-decoded-words-containing-tspecials t)) - (mime-to-mml ,'current-handles)) + (mime-to-mml ',current-handles)) (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) (set (make-local-variable 'mml-buffer-list) mbl1)) @@ -10886,8 +10944,8 @@ the actual number of articles unmarked is returned." (set var (cons article (symbol-value var))) (if (memq type '(processable cached replied forwarded recent saved)) (gnus-summary-update-secondary-mark article) - ;;; !!! This is bogus. We should find out what primary - ;;; !!! mark we want to set. + ;; !!! This is bogus. We should find out what primary + ;; !!! mark we want to set. (gnus-summary-update-mark gnus-del-mark 'unread))))) (defun gnus-summary-mark-as-expirable (n) @@ -12016,10 +12074,10 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'marks reverse)) -(defun gnus-summary-sort-by-original (&optional reverse) +(defun gnus-summary-sort-by-original (&optional _reverse) "Sort the summary buffer using the default sorting method. Argument REVERSE means reverse order." - (interactive "P") + (interactive) (let* ((inhibit-read-only t) (gnus-summary-prepare-hook nil)) ;; We do the sorting by regenerating the threads. @@ -12345,7 +12403,7 @@ save those articles instead." (string= to-newsgroup prefix)) (setq to-newsgroup default)) (unless to-newsgroup - (error "No group name entered")) + (user-error "No group name entered")) (setq encoded (encode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup))) @@ -12357,7 +12415,7 @@ save those articles instead." (gnus-activate-group encoded nil nil to-method) (gnus-subscribe-group encoded)) (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup)) + (user-error "No such group: %s" to-newsgroup)) encoded))) (defvar gnus-summary-save-parts-counter) @@ -12655,14 +12713,21 @@ If REVERSE, save parts that do not match TYPE." (c cond) (list gnus-summary-highlight)) (while list - (setcdr c (cons (list (caar list) (list 'quote (cdar list))) - nil)) + (setcdr c `((,(caar list) ',(cdar list)))) (setq c (cdr c) list (cdr list))) - (gnus-byte-compile (list 'lambda nil cond)))))) + (gnus-byte-compile + `(lambda () + (with-no-warnings ;See docstring of gnus-summary-highlight. + (defvar score) (defvar default) (defvar default-high) + (defvar default-low) (defvar mark) (defvar uncached)) + ,cond)))))) (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." + (with-no-warnings ;See docstring of gnus-summary-highlight. + (defvar score) (defvar default) (defvar default-high) (defvar default-low) + (defvar mark) (defvar uncached)) (let* ((beg (point-at-bol)) (article (or (gnus-summary-article-number) gnus-current-article)) (score (or (cdr (assq article From 3e5e097fdf056f4b3440993dd25ebdbad436abc3 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Fri, 5 Apr 2019 04:25:06 +0000 Subject: [PATCH 055/121] Make `move article' work again (bug#33653) * lisp/gnus/gnus-sum.el (gnus-summary-move-article): Back to while loop m dolist that blocks nov and active from saving (bug#33653). --- lisp/gnus/gnus-sum.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index fd72e1d3abb..8959a2b3d0a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10038,7 +10038,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref to-groups + art-group to-method new-xref article to-groups articles-to-update-marks encoded) (unless (assq action names) (error "Unknown action %s" action)) @@ -10088,7 +10088,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) - (dolist (article articles) + (while articles + (setq article (pop articles)) ;; Set any marks that may have changed in the summary buffer. (when gnus-preserve-marks (gnus-summary-push-marks-to-backend article)) From 8b2dad2891fe2d0ed4d163b4e63263f1068b8b3e Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Sun, 31 Mar 2019 09:09:18 -0700 Subject: [PATCH 056/121] Fix encoding and access of Gnus group names * lisp/gnus/gnus-start.el (gnus-active-to-gnus-format): Encode group names as 'latin-1. * lisp/gnus/nnmail.el (nnmail-parse-active): Ditto. * lisp/gnus/nnml.el (nnml-request-group, nnml-request-create-group, nnml-request-expire-articles, nnml-request-delete-group, nnml-request-rename-group, nnml-deletable-article-p, nnml-active-number, nnml-open-incremental-nov): Use assoc-string with nnml-group-alist. * lisp/gnus/nnrss.el (nnrss-request-delete-group, nnrss-retrieve-groups, nnrss-read-group-data, nnrss-check-group, nnrss-generate-download-script): Use assoc-string with nnrss-group-alist. --- lisp/gnus/gnus-start.el | 15 +++++++++------ lisp/gnus/nnmail.el | 2 +- lisp/gnus/nnml.el | 16 ++++++++-------- lisp/gnus/nnrss.el | 18 +++++++++--------- 4 files changed, 27 insertions(+), 24 deletions(-) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 9b1be650673..2beb685822f 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2145,12 +2145,15 @@ The info element is shared with the same element of (condition-case () (if (and (stringp (progn (setq group (read cur) - group (cond ((numberp group) - (number-to-string group)) - ((symbolp group) - (symbol-name group)) - ((stringp group) - group))))) + group + (encode-coding-string + (cond ((numberp group) + (number-to-string group)) + ((symbolp group) + (symbol-name group)) + ((stringp group) + group)) + 'latin-1)))) (numberp (setq max (read cur))) (numberp (setq min (read cur))) (null (progn diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index a95cdb4a4f8..b6dbbea74cc 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -663,7 +663,7 @@ nn*-request-list should have been called before calling this function." (narrow-to-region (point) (point-at-eol)) (setq group (read buffer)) (unless (stringp group) - (setq group (symbol-name group))) + (setq group (encode-coding-string (symbol-name group) 'latin-1))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) (push (list group (cons min max)) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 5770777ad4b..205e9e48034 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -259,7 +259,7 @@ non-nil.") (t (nnheader-re-read-dir nnml-current-directory) (nnmail-activate 'nnml) - (let ((active (nth 1 (assoc group nnml-group-alist)))) + (let ((active (nth 1 (assoc-string group nnml-group-alist)))) (if (not active) (nnheader-report 'nnml "No such group: %s" decoded) (nnheader-report 'nnml "Selected group %s" decoded) @@ -295,7 +295,7 @@ non-nil.") (nnheader-report 'nnml "%s is a file" (directory-file-name (nnml-group-pathname group nil server)))) - ((assoc group nnml-group-alist) + ((assoc-string group nnml-group-alist) t) (t (let (active) @@ -379,7 +379,7 @@ non-nil.") (nnml-nov-delete-article group number)) (push number rest))) (push number rest))) - (let ((active (nth 1 (assoc group nnml-group-alist)))) + (let ((active (nth 1 (assoc-string group nnml-group-alist)))) (when active (setcar active (or (and active-articles (apply 'min active-articles)) @@ -520,7 +520,7 @@ non-nil.") (nnheader-report 'nnml "No such directory: %s/" file)) ;; Remove the group from all structures. (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist) + (delq (assoc-string group nnml-group-alist) nnml-group-alist) nnml-current-group nil nnml-current-directory nil) ;; Save the active file. @@ -549,7 +549,7 @@ non-nil.") (when (<= (length (directory-files old-dir)) 2) (ignore-errors (delete-directory old-dir))) ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnml-group-alist))) + (let ((entry (assoc-string group nnml-group-alist))) (when entry (setcar entry new-name)) (setq nnml-current-directory nil @@ -597,7 +597,7 @@ non-nil.") (when (setq path (nnml-article-to-file article)) (when (file-writable-p path) (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) + (not (eq (cdr (nth 1 (assoc-string group nnml-group-alist))) article))))))) ;; Find an article number in the current group given the Message-ID. @@ -742,7 +742,7 @@ article number. This function is called narrowed to an article." "Compute the next article number in GROUP on SERVER." (let* ((encoded (if nnmail-group-names-not-encoded-p (nnml-encoded-group-name group server))) - (active (cadr (assoc (or encoded group) nnml-group-alist)))) + (active (cadr (assoc-string (or encoded group) nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. (unless active @@ -783,7 +783,7 @@ article number. This function is called narrowed to an article." (cdr nnml-incremental-nov-buffer-alist))))) (defun nnml-open-incremental-nov (group) - (or (cdr (assoc group nnml-incremental-nov-buffer-alist)) + (or (cdr (assoc-string group nnml-incremental-nov-buffer-alist)) (let ((buffer (nnml-get-nov-buffer group t))) (push (cons group buffer) nnml-incremental-nov-buffer-alist) buffer))) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 7f2accc2b66..0bfecb28e09 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -340,10 +340,10 @@ for decoding when the cdr that the data specify is not available.") (let (elem) ;; There may be two or more entries in `nnrss-group-alist' since ;; this function didn't delete them formerly. - (while (setq elem (assoc group nnrss-group-alist)) + (while (setq elem (assoc-string group nnrss-group-alist)) (setq nnrss-group-alist (delq elem nnrss-group-alist)))) (setq nnrss-server-data - (delq (assoc group nnrss-server-data) nnrss-server-data)) + (delq (assoc-string group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) (ignore-errors (let ((file-name-coding-system nnmail-pathname-coding-system)) @@ -367,7 +367,7 @@ for decoding when the cdr that the data specify is not available.") (with-current-buffer nntp-server-buffer (erase-buffer) (dolist (group groups) - (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data))) + (let ((elem (assoc-string (gnus-group-decoded-name group) nnrss-server-data))) (insert (format "%S %s 1 y\n" group (or (cadr elem) 0))))) 'active)) @@ -539,7 +539,7 @@ which RSS 2.0 allows." (if (hash-table-p nnrss-group-hashtb) (clrhash nnrss-group-hashtb) (setq nnrss-group-hashtb (make-hash-table :test 'equal))) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (setq nnrss-group-max (or (cadr pair) 0)) (setq nnrss-group-min (+ nnrss-group-max 1))) (let ((file (nnrss-make-filename group server)) @@ -644,8 +644,8 @@ which RSS 2.0 allows." (concat group ".xml")) nnrss-directory)))) (setq xml (nnrss-fetch file t)) - (setq url (or (nth 2 (assoc group nnrss-server-data)) - (cadr (assoc group nnrss-group-alist)))) + (setq url (or (nth 2 (assoc-string group nnrss-server-data)) + (cadr (assoc-string group nnrss-group-alist)))) (unless url (setq url (cdr @@ -653,7 +653,7 @@ which RSS 2.0 allows." (nnrss-discover-feed (read-string (format "URL to search for %s: " group) "http://"))))) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcdr (cdr pair) (list url)) (push (list group nnrss-group-max url) nnrss-server-data))) @@ -721,7 +721,7 @@ which RSS 2.0 allows." (setq extra nil)) (when changed (nnrss-save-group-data group server) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcar (cdr pair) nnrss-group-max) (push (list group nnrss-group-max) nnrss-server-data))) @@ -792,7 +792,7 @@ It is useful when `(setq nnrss-use-local t)'." (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n") (dolist (elem nnrss-server-data) (let ((url (or (nth 2 elem) - (cadr (assoc (car elem) nnrss-group-alist))))) + (cadr (assoc-string (car elem) nnrss-group-alist))))) (insert "$WGET -q -O \"$RSSDIR\"/'" (nnrss-translate-file-chars (concat (car elem) ".xml")) "' '" url "'\n")))) From 24d75c6667434a29a0c9db61ada8b29683fb3173 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Tue, 9 Apr 2019 04:15:57 +0000 Subject: [PATCH 057/121] Make `jump to group' work even if it is not activated (bug#33653) * lisp/gnus/gnus-group.el (gnus-group-goto-group): Use gnus-newsrc-hashtb instead of gnus-newsrc-hashtb to check if a group exists even if its server is not activated (bug#33653). --- lisp/gnus/gnus-group.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 0be38541745..58f3dc3a6ef 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2560,7 +2560,7 @@ If FAR, it is likely that the group is not on the current line. If TEST-MARKED, the line must be marked." (when group (let ((start (point)) - (active (and (gethash group gnus-active-hashtb) + (active (and (gethash group gnus-newsrc-hashtb) group))) (beginning-of-line) (cond From 12cbe2e9fb440379ae13559c786fbeba91873157 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Tue, 9 Apr 2019 04:15:57 +0000 Subject: [PATCH 058/121] Make `jump to group' work even if it is not activated (bug#33653) * lisp/gnus/gnus-group.el (gnus-group-goto-group): Use gnus-newsrc-hashtb instead of gnus-active-hashtb to check if a group exists even if its server is not activated (bug#33653). --- lisp/gnus/gnus-group.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 0be38541745..58f3dc3a6ef 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2560,7 +2560,7 @@ If FAR, it is likely that the group is not on the current line. If TEST-MARKED, the line must be marked." (when group (let ((start (point)) - (active (and (gethash group gnus-active-hashtb) + (active (and (gethash group gnus-newsrc-hashtb) group))) (beginning-of-line) (cond From e24cdf5c041d30b14b45da817655e36c70e825c2 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Tue, 9 Apr 2019 04:28:03 +0000 Subject: [PATCH 059/121] Fix last commit message --- .dir-locals.el | 22 ---------------------- 1 file changed, 22 deletions(-) delete mode 100644 .dir-locals.el diff --git a/.dir-locals.el b/.dir-locals.el deleted file mode 100644 index 9cd39920c23..00000000000 --- a/.dir-locals.el +++ /dev/null @@ -1,22 +0,0 @@ -((nil . ((tab-width . 8) - (sentence-end-double-space . t) - (fill-column . 70))) - (c-mode . ((c-file-style . "GNU") - (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) - (electric-quote-comment . nil) - (electric-quote-string . nil))) - (objc-mode . ((c-file-style . "GNU") - (electric-quote-comment . nil) - (electric-quote-string . nil))) - (log-edit-mode . ((log-edit-font-lock-gnu-style . t) - (log-edit-setup-add-author . t))) - (change-log-mode . ((add-log-time-zone-rule . t) - (fill-column . 74) - (bug-reference-url-format . "https://debbugs.gnu.org/%s") - (mode . bug-reference))) - (diff-mode . ((mode . whitespace))) - (emacs-lisp-mode . ((indent-tabs-mode . nil) - (electric-quote-comment . nil) - (electric-quote-string . nil))) - (texinfo-mode . ((electric-quote-comment . nil) - (electric-quote-string . nil)))) From e1872f80f24ab650f416ff8705898f12c7ad2800 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Tue, 9 Apr 2019 04:38:31 +0000 Subject: [PATCH 060/121] Restore .dir-locals.el accidentally deleted But this way -- git add/commit/push -- is probably wrong, sorry. --- .dir-locals.el | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 .dir-locals.el diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 00000000000..9cd39920c23 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,22 @@ +((nil . ((tab-width . 8) + (sentence-end-double-space . t) + (fill-column . 70))) + (c-mode . ((c-file-style . "GNU") + (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) + (electric-quote-comment . nil) + (electric-quote-string . nil))) + (objc-mode . ((c-file-style . "GNU") + (electric-quote-comment . nil) + (electric-quote-string . nil))) + (log-edit-mode . ((log-edit-font-lock-gnu-style . t) + (log-edit-setup-add-author . t))) + (change-log-mode . ((add-log-time-zone-rule . t) + (fill-column . 74) + (bug-reference-url-format . "https://debbugs.gnu.org/%s") + (mode . bug-reference))) + (diff-mode . ((mode . whitespace))) + (emacs-lisp-mode . ((indent-tabs-mode . nil) + (electric-quote-comment . nil) + (electric-quote-string . nil))) + (texinfo-mode . ((electric-quote-comment . nil) + (electric-quote-string . nil)))) From 58c77f1f3e041be320a05efb818a0e2bb1583e84 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sat, 9 Feb 2019 15:42:42 -0800 Subject: [PATCH 061/121] Add failing tests for JSX indentation bugs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * test/manual/indent/js-jsx.js: Add failing tests for all the js-mode and js2-mode JSX indentation bugs reported over the years that I could find. Some may be duplicates, so I have grouped similar reports together, for now; we’ll see for certain which distinct cases we need once we start actually implementing fixes. * test/manual/indent/js-jsx-quote.js: New file with a nasty test. --- test/manual/indent/js-jsx-quote.js | 18 +++ test/manual/indent/js-jsx.js | 183 +++++++++++++++++++++++++++++ 2 files changed, 201 insertions(+) create mode 100644 test/manual/indent/js-jsx-quote.js diff --git a/test/manual/indent/js-jsx-quote.js b/test/manual/indent/js-jsx-quote.js new file mode 100644 index 00000000000..4b71a656744 --- /dev/null +++ b/test/manual/indent/js-jsx-quote.js @@ -0,0 +1,18 @@ +// -*- mode: js-jsx; -*- + +// JSX text node values should be strings, but only JS string syntax +// is considered, so quote marks delimit strings like normal, with +// disastrous results (https://github.com/mooz/js2-mode/issues/409). +function Bug() { + return
C'est Montréal
; +} +function Test(foo = /'/, + bar = 123) {} + +// This test is in a separate file because it can break other tests +// when indenting the whole buffer (not sure why). + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js index 7401939d282..35ca4b275a6 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/js-jsx.js @@ -70,6 +70,189 @@ return ( ); +// Indent void expressions (no need for contextual parens / commas) +// (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016). +
+

Title

+ {array.map(() => { + return ; + })} + {message} +
+// Another example of above issue +// (https://github.com/mooz/js2-mode/issues/490). + +
+ {variable1} + +
+ + +// Comments and arrows can break indentation (Bug#24896 / +// https://github.com/mooz/js2-mode/issues/389). +const Component = props => ( + c} + b={123}> + +); +const Component = props => ( + + +); +const Component = props => ( // Parse this comment, please. + c} + b={123}> + +); +const Component = props => ( // Parse this comment, please. + + +); +// Another example of above issue (Bug#30225). +class { + render() { + return ( + + ); + } +} + +// JSX attributes of an arrow function’s expression body’s JSX +// expression should be indented with respect to the JSX opening +// element (Bug#26001 / +// https://github.com/mooz/js2-mode/issues/389#issuecomment-271869380). +class { + render() { + const messages = this.state.messages.map( + message => + ); return messages; + } + render() { + const messages = this.state.messages.map(message => + + ); return messages; + } +} + +// Users expect tag closers to align with the tag’s start; this is the +// style used in the React docs, so it should be the default. +// - https://github.com/mooz/js2-mode/issues/389#issuecomment-390766873 +// - https://github.com/mooz/js2-mode/issues/482 +// - Bug#32158 +const foo = (props) => ( +
+ i} + /> + +
+); + +// Embedded JSX in parens breaks indentation +// (https://github.com/mooz/js2-mode/issues/411). +let a = ( +
+ {condition && } + {condition && } +
+
+) +let b = ( +
+ {condition && ()} +
+
+) +let c = ( +
+ {condition && ()} + {condition && "something"} +
+) +let d = ( +
+ {()} + {condition && "something"} +
+) +// Another example of the above issue (Bug#27000). +function testA() { + return ( +
+
{ (
) }
+
+ ); +} +function testB() { + return ( +
+
{
}
+
+ ); +} +// Another example of the above issue +// (https://github.com/mooz/js2-mode/issues/451). +class Classy extends React.Component { + render () { + return ( +
+
    + { this.state.list.map((item) => { + return (
    ) + })} +
+
+ ) + } +} + +// Self-closing tags should be indented properly +// (https://github.com/mooz/js2-mode/issues/459). +export default ({ stars }) => ( +
+
+ Congratulations! +
+
+ 0)} size='large' /> +
+ 1)} size='small' /> + 2)} size='small' /> +
+
+
+ You have created 1 reminder +
+
+) + +// JS expressions should not break indentation +// (https://github.com/mooz/js2-mode/issues/462). +return ( + + + ( +
nothing
+ )} /> + + + +) + // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 From 4b305bb185596dff5d02cf54da7a41c3e082b7d4 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sat, 9 Feb 2019 20:06:29 -0800 Subject: [PATCH 062/121] Refactor JSX indentation code to improve enclosing JSX discovery MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fix a number of bugs reported for JSX indentation (caused by poor JSX detection): - https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016 - https://github.com/mooz/js2-mode/issues/490 - Bug#24896 / https://github.com/mooz/js2-mode/issues/389 (with respect to comments) - Bug#26001 / https://github.com/mooz/js2-mode/issues/389#issuecomment-271869380 - https://github.com/mooz/js2-mode/issues/411 / Bug#27000 / https://github.com/mooz/js2-mode/issues/451 Potentially manifest some new bugs (due to false positives with ‘<’ and ‘>’ and SGML detection). Slow down indentation a fair bit. * list/progmodes/js.el (js-jsx-syntax, js--jsx-start-tag-re) (js--looking-at-jsx-start-tag-p, js--looking-back-at-jsx-end-tag-p): New variables and functions. (js--jsx-find-before-tag, js--jsx-after-tag-re): Deleted. (js--looking-at-operator-p): Don’t mistake a JSXOpeningElement for the ‘<’ operator. (js--continued-expression-p): Don’t mistake a JSXClosingElement as a fragment of a continued expression including the ‘>’ operator. (js--as-sgml): Simplify. Probably needn’t bind forward-sexp-function to nil (sgml-mode already does) and probably shouldn’t bind parse-sexp-lookup-properties to nil either (see Bug#24896). (js--outermost-enclosing-jsx-tag-pos): Find enclosing JSX more accurately than js--jsx-find-before-tag. Use sgml-mode’s parsing logic, rather than unreliable heuristics like paren-wrapping. This implementation is much slower; the previous implementation was fast, but at the expense of accuracy. To make up for all the grief we’ve caused users, we will prefer accuracy over speed from now on. That said, this can still probably be optimized a lot. (js--jsx-indented-element-p): Rename to js--jsx-indentation, since it doesn’t just return a boolean. (js--jsx-indentation): Refactor js--jsx-indented-element-p to simplify the implementation as the improved accuracy of other code allows (and to repent for some awful stylistic choices I made earlier). (js--expression-in-sgml-indent-line): Rename to js--indent-line-in-jsx-expression, since it’s a private function and we can give it a name that reads more like English. (js--indent-line-in-jsx-expression): Restructure point adjustment logic more like js-indent-line. (js--indent-n+1th-jsx-line): New function to complement js--indent-line-in-jsx-expression. (js-jsx-indent-line): Refactor. Don’t bind js--continued-expression-p to ignore any more; instead, rely on the improved accuracy of js--continued-expression-p. (js-jsx-mode): Set js-jsx-syntax to t. For now, this will be the flag we use to determine whether ‘JSX is enabled.’ (Maybe later, we will refactor the code to use this variable instead of requiring js-jsx-mode to be enabled, thus rendering the mode obsolete.) --- lisp/progmodes/js.el | 343 ++++++++++++++++++------------------------- 1 file changed, 144 insertions(+), 199 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 4d91da73340..5b992535a8c 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -572,6 +572,15 @@ then the \".\"s will be lined up: :safe 'booleanp :group 'js) +(defcustom js-jsx-syntax nil + "When non-nil, parse JavaScript with consideration for JSX syntax. +This fixes indentation of JSX code in some cases. It is set to +be buffer-local when in `js-jsx-mode'." + :version "27.1" + :type 'boolean + :safe 'booleanp + :group 'js) + ;;; KeyMap (defvar js-mode-map @@ -1774,6 +1783,14 @@ This performs fontification according to `js--class-styles'." (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") +(defconst js--jsx-start-tag-re + (concat "<" sgml-name-re) + "Regexp matching code that looks like a JSXOpeningElement.") + +(defun js--looking-at-jsx-start-tag-p () + "Non-nil if a JSXOpeningElement immediately follows point." + (looking-at js--jsx-start-tag-re)) + (defun js--looking-at-operator-p () "Return non-nil if point is on a JavaScript operator, other than a comma." (save-match-data @@ -1796,7 +1813,9 @@ This performs fontification according to `js--class-styles'." (js--backward-syntactic-ws) ;; We might misindent some expressions that would ;; return NaN anyway. Shouldn't be a problem. - (memq (char-before) '(?, ?} ?{)))))))) + (memq (char-before) '(?, ?} ?{))))) + ;; “<” isn’t necessarily an operator in JSX. + (not (and js-jsx-syntax (js--looking-at-jsx-start-tag-p)))))) (defun js--find-newline-backward () "Move backward to the nearest newline that is not in a block comment." @@ -1816,6 +1835,14 @@ This performs fontification according to `js--class-styles'." (setq result nil))) result)) +(defconst js--jsx-end-tag-re + (concat "\\|/>") + "Regexp matching a JSXClosingElement.") + +(defun js--looking-back-at-jsx-end-tag-p () + "Non-nil if a JSXClosingElement immediately precedes point." + (looking-back js--jsx-end-tag-re (point-at-bol))) + (defun js--continued-expression-p () "Return non-nil if the current line continues an expression." (save-excursion @@ -1833,12 +1860,19 @@ This performs fontification according to `js--class-styles'." (and (js--find-newline-backward) (progn (skip-chars-backward " \t") - (or (bobp) (backward-char)) - (and (> (point) (point-min)) - (save-excursion (backward-char) (not (looking-at "[/*]/\\|=>"))) - (js--looking-at-operator-p) - (and (progn (backward-char) - (not (looking-at "\\+\\+\\|--\\|/[/*]")))))))))) + (and + ;; The “>” at the end of any JSXBoundaryElement isn’t + ;; part of a continued expression. + (not (and js-jsx-syntax (js--looking-back-at-jsx-end-tag-p))) + (progn + (or (bobp) (backward-char)) + (and (> (point) (point-min)) + (save-excursion + (backward-char) + (not (looking-at "[/*]/\\|=>"))) + (js--looking-at-operator-p) + (and (progn (backward-char) + (not (looking-at "\\+\\+\\|--\\|/[/*]")))))))))))) (defun js--skip-term-backward () "Skip a term before point; return t if a term was skipped." @@ -2153,190 +2187,108 @@ current line is the \"=>\" token." ;;; JSX Indentation -(defsubst js--jsx-find-before-tag () - "Find where JSX starts. - -Assume JSX appears in the following instances: -- Inside parentheses, when returned or as the first argument - to a function, and after a newline -- When assigned to variables or object properties, but only - on a single line -- As the N+1th argument to a function - -This is an optimized version of (re-search-backward \"[(,]\n\" -nil t), except set point to the end of the match. This logic -executes up to the number of lines in the file, so it should be -really fast to reduce that impact." - (let (pos) - (while (and (> (point) (point-min)) - (not (progn - (end-of-line 0) - (when (or (eq (char-before) 40) ; ( - (eq (char-before) 44)) ; , - (setq pos (1- (point)))))))) - pos)) - -(defconst js--jsx-end-tag-re - (concat "\\|/>") - "Find the end of a JSX element.") - -(defconst js--jsx-after-tag-re "[),]" - "Find where JSX ends. -This complements the assumption of where JSX appears from -`js--jsx-before-tag-re', which see.") - -(defun js--jsx-indented-element-p () - "Determine if/how the current line should be indented as JSX. - -Return `first' for the first JSXElement on its own line. -Return `nth' for subsequent lines of the first JSXElement. -Return `expression' for an embedded JS expression. -Return `after' for anything after the last JSXElement. -Return nil for non-JSX lines. - -Currently, JSX indentation supports the following styles: - -- Single-line elements (indented like normal JS): - - var element =
; - -- Multi-line elements (enclosed in parentheses): - - function () { - return ( -
-
-
- ); - } - -- Function arguments: - - React.render( -
, - document.querySelector('.root') - );" - (let ((current-pos (point)) - (current-line (line-number-at-pos)) - last-pos - before-tag-pos before-tag-line - tag-start-pos tag-start-line - tag-end-pos tag-end-line - after-tag-line - parens paren type) - (save-excursion - (and - ;; Determine if we're inside a jsx element - (progn - (end-of-line) - (while (and (not tag-start-pos) - (setq last-pos (js--jsx-find-before-tag))) - (while (forward-comment 1)) - (when (= (char-after) 60) ; < - (setq before-tag-pos last-pos - tag-start-pos (point))) - (goto-char last-pos)) - tag-start-pos) - (progn - (setq before-tag-line (line-number-at-pos before-tag-pos) - tag-start-line (line-number-at-pos tag-start-pos)) - (and - ;; A "before" line which also starts an element begins with js, so - ;; indent it like js - (> current-line before-tag-line) - ;; Only indent the jsx lines like jsx - (>= current-line tag-start-line))) - (cond - ;; Analyze bounds if there are any - ((progn - (while (and (not tag-end-pos) - (setq last-pos (re-search-forward js--jsx-end-tag-re nil t))) - (while (forward-comment 1)) - (when (looking-at js--jsx-after-tag-re) - (setq tag-end-pos last-pos))) - tag-end-pos) - (setq tag-end-line (line-number-at-pos tag-end-pos) - after-tag-line (line-number-at-pos after-tag-line)) - (or (and - ;; Ensure we're actually within the bounds of the jsx - (<= current-line tag-end-line) - ;; An "after" line which does not end an element begins with - ;; js, so indent it like js - (<= current-line after-tag-line)) - (and - ;; Handle another case where there could be e.g. comments after - ;; the element - (> current-line tag-end-line) - (< current-line after-tag-line) - (setq type 'after)))) - ;; They may not be any bounds (yet) - (t)) - ;; Check if we're inside an embedded multi-line js expression - (cond - ((not type) - (goto-char current-pos) - (end-of-line) - (setq parens (nth 9 (syntax-ppss))) - (while (and parens (not type)) - (setq paren (car parens)) - (cond - ((and (>= paren tag-start-pos) - ;; Curly bracket indicates the start of an embedded expression - (= (char-after paren) 123) ; { - ;; The first line of the expression is indented like sgml - (> current-line (line-number-at-pos paren)) - ;; Check if within a closing curly bracket (if any) - ;; (exclusive, as the closing bracket is indented like sgml) - (cond - ((progn - (goto-char paren) - (ignore-errors (let (forward-sexp-function) - (forward-sexp)))) - (< current-line (line-number-at-pos))) - (t))) - ;; Indicate this guy will be indented specially - (setq type 'expression)) - (t (setq parens (cdr parens))))) - t) - (t)) - (cond - (type) - ;; Indent the first jsx thing like js so we can indent future jsx things - ;; like sgml relative to the first thing - ((= current-line tag-start-line) 'first) - ('nth)))))) - (defmacro js--as-sgml (&rest body) "Execute BODY as if in sgml-mode." `(with-syntax-table sgml-mode-syntax-table - (let (forward-sexp-function - parse-sexp-lookup-properties) - ,@body))) + ,@body)) -(defun js--expression-in-sgml-indent-line () - "Indent the current line as JavaScript or SGML (whichever is farther)." - (let* (indent-col - (savep (point)) - ;; Don't whine about errors/warnings when we're indenting. - ;; This has to be set before calling parse-partial-sexp below. - (inhibit-point-motion-hooks t) - (parse-status (save-excursion - (syntax-ppss (point-at-bol))))) - ;; Don't touch multiline strings. +(defun js--outermost-enclosing-jsx-tag-pos () + (let (context tag-pos last-tag-pos parse-status parens paren-pos curly-pos) + (js--as-sgml + ;; Search until we reach the top or encounter the start of a + ;; JSXExpressionContainer (implying nested JSX). + (while (and (setq context (sgml-get-context)) + (progn + (setq tag-pos (sgml-tag-start (car (last context)))) + (or (not curly-pos) + ;; Stop before curly brackets (start of a + ;; JSXExpressionContainer). + (> tag-pos curly-pos)))) + ;; Record this position so it can potentially be returned. + (setq last-tag-pos tag-pos) + ;; Always parse sexps / search for the next context from the + ;; immediately enclosing tag (sgml-get-context may not leave + ;; point there). + (goto-char tag-pos) + (unless parse-status ; Don’t needlessly reparse. + ;; Search upward for an enclosing starting curly bracket. + (setq parse-status (syntax-ppss)) + (setq parens (reverse (nth 9 parse-status))) + (while (and (setq paren-pos (car parens)) + (not (when (= (char-after paren-pos) ?{) + (setq curly-pos paren-pos)))) + (setq parens (cdr parens))) + ;; Always search for the next context from the immediately + ;; enclosing tag (calling syntax-ppss in the above loop + ;; may move point from there). + (goto-char tag-pos)))) + last-tag-pos)) + +(defun js--jsx-indentation () + "Determine if/how the current line should be indented as JSX. + +Return nil for first JSXElement line (indent like JS). +Return `n+1th' for second+ JSXElement lines (indent like SGML). +Return `expression' for lines within embedded JS expressions + (indent like JS inside SGML). +Return nil for non-JSX lines." + (let ((current-pos (point)) + (current-line (line-number-at-pos)) + tag-start-pos parens paren type) + (save-excursion + ;; Determine if inside a JSXElement. + (beginning-of-line) ; For exclusivity + (when (setq tag-start-pos (js--outermost-enclosing-jsx-tag-pos)) + ;; Check if inside an embedded multi-line JS expression. + (goto-char current-pos) + (end-of-line) ; For exclusivity + (setq parens (nth 9 (syntax-ppss))) + (while + (and + (setq paren (car parens)) + (if (and + (>= paren tag-start-pos) + ;; A curly bracket indicates the start of an + ;; embedded expression. + (= (char-after paren) ?{) + ;; The first line of the expression is indented + ;; like SGML. + (> current-line (line-number-at-pos paren)) + ;; Check if within a closing curly bracket (if any) + ;; (exclusive, as the closing bracket is indented + ;; like SGML). + (if (progn + (goto-char paren) + (ignore-errors (let (forward-sexp-function) + (forward-sexp)))) + (< current-line (line-number-at-pos)) + ;; No matching bracket implies we’re inside! + t)) + ;; Indicate this will be indented specially. Return + ;; nil to stop iterating too. + (progn (setq type 'expression) nil) + ;; Stop iterating when parens = nil. + (setq parens (cdr parens))))) + (or type 'n+1th))))) + +(defun js--indent-line-in-jsx-expression () + "Indent the current line as JavaScript within JSX." + (let ((parse-status (save-excursion (syntax-ppss (point-at-bol)))) + offset indent-col) (unless (nth 3 parse-status) - (setq indent-col (save-excursion - (back-to-indentation) - (if (>= (point) savep) (setq savep nil)) - (js--as-sgml (sgml-calculate-indent)))) - (if (null indent-col) - 'noindent - ;; Use whichever indentation column is greater, such that the sgml - ;; column is effectively a minimum - (setq indent-col (max (js--proper-indentation parse-status) - (+ indent-col js-indent-level))) - (if savep - (save-excursion (indent-line-to indent-col)) - (indent-line-to indent-col)))))) + (save-excursion + (setq offset (- (point) (progn (back-to-indentation) (point))) + indent-col (js--as-sgml (sgml-calculate-indent)))) + (if (null indent-col) 'noindent ; Like in sgml-mode + ;; Use whichever indentation column is greater, such that the + ;; SGML column is effectively a minimum. + (indent-line-to (max (js--proper-indentation parse-status) + (+ indent-col js-indent-level))) + (when (> offset 0) (forward-char offset)))))) + +(defun js--indent-n+1th-jsx-line () + "Indent the current line as JSX within JavaScript." + (js--as-sgml (sgml-indent-line))) (defun js-indent-line () "Indent the current line as JavaScript." @@ -2353,19 +2305,11 @@ Currently, JSX indentation supports the following styles: i.e., customize JSX element indentation with `sgml-basic-offset', `sgml-attribute-offset' et al." (interactive) - (let ((indentation-type (js--jsx-indented-element-p))) - (cond - ((eq indentation-type 'expression) - (js--expression-in-sgml-indent-line)) - ((or (eq indentation-type 'first) - (eq indentation-type 'after)) - ;; Don't treat this first thing as a continued expression (often a "<" or - ;; ">" causes this misinterpretation) - (cl-letf (((symbol-function #'js--continued-expression-p) 'ignore)) - (js-indent-line))) - ((eq indentation-type 'nth) - (js--as-sgml (sgml-indent-line))) - (t (js-indent-line))))) + (let ((type (js--jsx-indentation))) + (if type + (if (eq type 'n+1th) (js--indent-n+1th-jsx-line) + (js--indent-line-in-jsx-expression)) + (js-indent-line)))) ;;; Filling @@ -3944,6 +3888,7 @@ locally, like so: (setq-local sgml-basic-offset js-indent-level)) (add-hook \\='js-jsx-mode-hook #\\='set-jsx-indentation)" :group 'js + (setq-local js-jsx-syntax t) (setq-local indent-line-function #'js-jsx-indent-line)) ;;;###autoload (defalias 'javascript-mode 'js-mode) From 27e9bce77db54464737aa5be1ce7142b55f25952 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 10 Feb 2019 21:11:17 -0800 Subject: [PATCH 063/121] Add new (failing) unclosed JSX test and separate such tests * test/manual/indent/js-jsx.js: Move test with intentional scan error to its own file, js-jsx-unclosed-1.js. * test/manual/indent/js-jsx-unclosed-1.js: New file. * test/manual/indent/js-jsx-unclosed-2.js: New file with test for regression caused by new ambiguous parsing of JS/JSX. --- test/manual/indent/js-jsx-unclosed-1.js | 15 +++++++++++++++ test/manual/indent/js-jsx-unclosed-2.js | 17 +++++++++++++++++ test/manual/indent/js-jsx.js | 9 --------- 3 files changed, 32 insertions(+), 9 deletions(-) create mode 100644 test/manual/indent/js-jsx-unclosed-1.js create mode 100644 test/manual/indent/js-jsx-unclosed-2.js diff --git a/test/manual/indent/js-jsx-unclosed-1.js b/test/manual/indent/js-jsx-unclosed-1.js new file mode 100644 index 00000000000..9418aed7a12 --- /dev/null +++ b/test/manual/indent/js-jsx-unclosed-1.js @@ -0,0 +1,15 @@ +// -*- mode: js-jsx; -*- + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following test goes below any comments to avoid including +// misindented comments among the erroring lines. + +return ( +
+ {array.map(function () { + return { + a: 1 diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/js-jsx-unclosed-2.js new file mode 100644 index 00000000000..2d42cf70f84 --- /dev/null +++ b/test/manual/indent/js-jsx-unclosed-2.js @@ -0,0 +1,17 @@ +// -*- mode: js-jsx; -*- + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following tests go below any comments to avoid including +// misindented comments among the erroring lines. + +// Don’t misinterpret equality operators as JSX. +for (; i < length;) void 0 +if (foo > bar) void 0 + +// Don’t even misinterpret unary operators as JSX. +if (foo < await bar) void 0 +while (await foo > bar) void 0 diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js index 35ca4b275a6..af3c3405590 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/js-jsx.js @@ -257,12 +257,3 @@ return ( // indent-tabs-mode: nil // js-indent-level: 2 // End: - -// The following test has intentionally unclosed elements and should -// be placed below all other tests to prevent awkward indentation. - -return ( -
- {array.map(function () { - return { - a: 1 From be86ece42cbb6204480c794d018b02fbda74689b Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Mon, 11 Feb 2019 03:00:34 -0800 Subject: [PATCH 064/121] js-syntax-propertize: Disambiguate JS from JSX, fixing some indents MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fix some JSX indentation bugs: - Bug#24896 / https://github.com/mooz/js2-mode/issues/389 - Bug#30225 - https://github.com/mooz/js2-mode/issues/459 * lisp/progmodes/js.el (js--dotted-captured-name-re) (js--unary-keyword-re, js--unary-keyword-p) (js--disambiguate-beginning-of-jsx-tag) (js--disambiguate-end-of-jsx-tag) (js--disambiguate-js-from-jsx): New variables and functions. (js-syntax-propertize): Additionally clarify when syntax is JS so that ‘(with-syntax-table sgml-mode-syntax-table …)’ does not mistake some JS punctuation syntax for SGML parenthesis syntax, namely ‘<’ and ‘>’. * test/manual/indent/js-jsx-unclosed-2.js: Add additional test for unary operator parsing. --- lisp/progmodes/js.el | 100 +++++++++++++++++++++++- test/manual/indent/js-jsx-unclosed-2.js | 14 ++++ 2 files changed, 113 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5b992535a8c..d0556f3538e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -82,6 +82,10 @@ (concat js--name-re "\\(?:\\." js--name-re "\\)*") "Regexp matching a dot-separated sequence of JavaScript names.") +(defconst js--dotted-captured-name-re + (concat "\\(" js--name-re "\\)\\(?:\\." js--name-re "\\)*") + "Like `js--dotted-name-re', but capture the first name.") + (defconst js--cpp-name-re js--name-re "Regexp matching a C preprocessor name.") @@ -1731,6 +1735,99 @@ This performs fontification according to `js--class-styles'." 'syntax-table (string-to-syntax "\"/")) (goto-char end))))) +(defconst js--unary-keyword-re + (js--regexp-opt-symbol '("await" "delete" "typeof" "void" "yield")) + "Regexp matching unary operator keywords.") + +(defun js--unary-keyword-p (string) + "Check if STRING is a unary operator keyword in JavaScript." + (string-match-p js--unary-keyword-re string)) + +(defun js--disambiguate-beginning-of-jsx-tag () + "Parse enough to determine if a JSX tag starts here. +Disambiguate JSX from equality operators by testing for syntax +only valid as JSX." + ;; “” - a JSXOpeningFragment. + (if (memq (char-after) '(?\/ ?\>)) t + (save-excursion + (skip-chars-forward " \t\n") + (and + (looking-at js--dotted-captured-name-re) + ;; Don’t match code like “if (i < await foo)” + (not (js--unary-keyword-p (match-string 1))) + (progn + (goto-char (match-end 0)) + (skip-chars-forward " \t\n") + (or + ;; “>”, “/>” - tag enders. + ;; “{” - a JSXExpressionContainer. + (memq (char-after) '(?\> ?\/ ?\{)) + ;; Check if a JSXAttribute follows. + (looking-at js--name-start-re))))))) + +(defun js--disambiguate-end-of-jsx-tag () + "Parse enough to determine if a JSX tag ends here. +Disambiguate JSX from equality operators by testing for syntax +only valid as JSX, or extremely unlikely except as JSX." + (save-excursion + (backward-char) + ;; “…/>” - a self-closing JSXOpeningElement. + ;; “” - a JSXClosingFragment. + (if (= (char-before) ?/) t + (let (last-tag-or-attr-name last-non-unary-p) + (catch 'match + (while t + (skip-chars-backward " \t\n") + ;; Check if the end of a JSXAttribute value or + ;; JSXExpressionContainer almost certainly precedes. + ;; The only valid JS this misses is + ;; - {} > foo + ;; - "bar" > foo + ;; which is no great loss, IMHO… + (if (memq (char-before) '(?\} ?\" ?\' ?\`)) (throw 'match t) + (if (and last-tag-or-attr-name last-non-unary-p + ;; “<”, “’ chars (from START to END) aren’t JSX. + +Later, this info prevents ‘sgml-’ functions from treating some +‘<’ and ‘>’ chars as parts of tokens of SGML tags — a good thing, +since they are serving their usual function as some JS equality +operator or arrow function, instead." + (goto-char start) + (while (re-search-forward "[<>]" end t) + (unless (if (eq (char-before) ?<) (js--disambiguate-beginning-of-jsx-tag) + (js--disambiguate-end-of-jsx-tag)) + ;; Inform sgml- functions that this >, >=, >>>, <, <=, <<<, or + ;; => token is punctuation (and not an open or close parenthesis + ;; as per usual in sgml-mode). + (put-text-property (1- (point)) (point) 'syntax-table '(1))))) + (defun js-syntax-propertize (start end) ;; JavaScript allows immediate regular expression objects, written /.../. (goto-char start) @@ -1758,7 +1855,8 @@ This performs fontification according to `js--class-styles'." 'syntax-table (string-to-syntax "\"/")) (js-syntax-propertize-regexp end))))) ("\\`\\(#\\)!" (1 "< b"))) - (point) end)) + (point) end) + (if js-jsx-syntax (js--disambiguate-js-from-jsx start end))) (defconst js--prettify-symbols-alist '(("=>" . ?⇒) diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/js-jsx-unclosed-2.js index 2d42cf70f84..8b6f33325d7 100644 --- a/test/manual/indent/js-jsx-unclosed-2.js +++ b/test/manual/indent/js-jsx-unclosed-2.js @@ -15,3 +15,17 @@ if (foo > bar) void 0 // Don’t even misinterpret unary operators as JSX. if (foo < await bar) void 0 while (await foo > bar) void 0 + +// Allow unary keyword names as null-valued JSX attributes. +// (As if this will EVER happen…) + + + + + How would we ever live without unary support + + + + From 6f535762df1f8f55faa36878d4a2a0a8b112f666 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Fri, 15 Feb 2019 22:15:11 -0800 Subject: [PATCH 065/121] Use js-jsx- prefix for functions and variables * lisp/progmodes/js.el (js--disambiguate-beginning-of-jsx-tag): Rename to js-jsx--disambiguate-beginning-of-tag. (js--disambiguate-end-of-jsx-tag): Rename to js-jsx--disambiguate-end-of-tag. (js--disambiguate-js-from-jsx): Rename to js-jsx--disambiguate-syntax. (js--jsx-start-tag-re): Rename to js-jsx--start-tag-re. (js--looking-at-jsx-start-tag-p): Rename to js-jsx--looking-at-start-tag-p. (js--jsx-end-tag-re): Rename to js-jsx--end-tag-re. (js--looking-back-at-jsx-end-tag-p): Rename to js-jsx--looking-back-at-end-tag-p. (js--as-sgml): Rename to js-jsx--as-sgml. (js--outermost-enclosing-jsx-tag-pos): Rename to js-jsx--outermost-enclosing-tag-pos. (js--jsx-indentation): Rename to js-jsx--indentation-type. (js--indent-line-in-jsx-expression): Rename to js-jsx--indent-line-in-expression. (js--indent-n+1th-jsx-line): Rename to js-jsx--indent-n+1th-line. --- lisp/progmodes/js.el | 52 ++++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index d0556f3538e..4404ea04a03 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1743,7 +1743,7 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) -(defun js--disambiguate-beginning-of-jsx-tag () +(defun js-jsx--disambiguate-beginning-of-tag () "Parse enough to determine if a JSX tag starts here. Disambiguate JSX from equality operators by testing for syntax only valid as JSX." @@ -1766,7 +1766,7 @@ only valid as JSX." ;; Check if a JSXAttribute follows. (looking-at js--name-start-re))))))) -(defun js--disambiguate-end-of-jsx-tag () +(defun js-jsx--disambiguate-end-of-tag () "Parse enough to determine if a JSX tag ends here. Disambiguate JSX from equality operators by testing for syntax only valid as JSX, or extremely unlikely except as JSX." @@ -1812,7 +1812,7 @@ only valid as JSX, or extremely unlikely except as JSX." ;; Nothing else to look for; give up parsing. (throw 'match nil))))))))) -(defun js--disambiguate-js-from-jsx (start end) +(defun js-jsx--disambiguate-syntax (start end) "Figure out which ‘<’ and ‘>’ chars (from START to END) aren’t JSX. Later, this info prevents ‘sgml-’ functions from treating some @@ -1821,8 +1821,8 @@ since they are serving their usual function as some JS equality operator or arrow function, instead." (goto-char start) (while (re-search-forward "[<>]" end t) - (unless (if (eq (char-before) ?<) (js--disambiguate-beginning-of-jsx-tag) - (js--disambiguate-end-of-jsx-tag)) + (unless (if (eq (char-before) ?<) (js-jsx--disambiguate-beginning-of-tag) + (js-jsx--disambiguate-end-of-tag)) ;; Inform sgml- functions that this >, >=, >>>, <, <=, <<<, or ;; => token is punctuation (and not an open or close parenthesis ;; as per usual in sgml-mode). @@ -1856,7 +1856,7 @@ operator or arrow function, instead." (js-syntax-propertize-regexp end))))) ("\\`\\(#\\)!" (1 "< b"))) (point) end) - (if js-jsx-syntax (js--disambiguate-js-from-jsx start end))) + (if js-jsx-syntax (js-jsx--disambiguate-syntax start end))) (defconst js--prettify-symbols-alist '(("=>" . ?⇒) @@ -1881,13 +1881,13 @@ operator or arrow function, instead." (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") -(defconst js--jsx-start-tag-re +(defconst js-jsx--start-tag-re (concat "<" sgml-name-re) "Regexp matching code that looks like a JSXOpeningElement.") -(defun js--looking-at-jsx-start-tag-p () +(defun js-jsx--looking-at-start-tag-p () "Non-nil if a JSXOpeningElement immediately follows point." - (looking-at js--jsx-start-tag-re)) + (looking-at js-jsx--start-tag-re)) (defun js--looking-at-operator-p () "Return non-nil if point is on a JavaScript operator, other than a comma." @@ -1913,7 +1913,7 @@ operator or arrow function, instead." ;; return NaN anyway. Shouldn't be a problem. (memq (char-before) '(?, ?} ?{))))) ;; “<” isn’t necessarily an operator in JSX. - (not (and js-jsx-syntax (js--looking-at-jsx-start-tag-p)))))) + (not (and js-jsx-syntax (js-jsx--looking-at-start-tag-p)))))) (defun js--find-newline-backward () "Move backward to the nearest newline that is not in a block comment." @@ -1933,13 +1933,13 @@ operator or arrow function, instead." (setq result nil))) result)) -(defconst js--jsx-end-tag-re +(defconst js-jsx--end-tag-re (concat "\\|/>") "Regexp matching a JSXClosingElement.") -(defun js--looking-back-at-jsx-end-tag-p () +(defun js-jsx--looking-back-at-end-tag-p () "Non-nil if a JSXClosingElement immediately precedes point." - (looking-back js--jsx-end-tag-re (point-at-bol))) + (looking-back js-jsx--end-tag-re (point-at-bol))) (defun js--continued-expression-p () "Return non-nil if the current line continues an expression." @@ -1961,7 +1961,7 @@ operator or arrow function, instead." (and ;; The “>” at the end of any JSXBoundaryElement isn’t ;; part of a continued expression. - (not (and js-jsx-syntax (js--looking-back-at-jsx-end-tag-p))) + (not (and js-jsx-syntax (js-jsx--looking-back-at-end-tag-p))) (progn (or (bobp) (backward-char)) (and (> (point) (point-min)) @@ -2285,14 +2285,14 @@ current line is the \"=>\" token." ;;; JSX Indentation -(defmacro js--as-sgml (&rest body) +(defmacro js-jsx--as-sgml (&rest body) "Execute BODY as if in sgml-mode." `(with-syntax-table sgml-mode-syntax-table ,@body)) -(defun js--outermost-enclosing-jsx-tag-pos () +(defun js-jsx--outermost-enclosing-tag-pos () (let (context tag-pos last-tag-pos parse-status parens paren-pos curly-pos) - (js--as-sgml + (js-jsx--as-sgml ;; Search until we reach the top or encounter the start of a ;; JSXExpressionContainer (implying nested JSX). (while (and (setq context (sgml-get-context)) @@ -2322,7 +2322,7 @@ current line is the \"=>\" token." (goto-char tag-pos)))) last-tag-pos)) -(defun js--jsx-indentation () +(defun js-jsx--indentation-type () "Determine if/how the current line should be indented as JSX. Return nil for first JSXElement line (indent like JS). @@ -2336,7 +2336,7 @@ Return nil for non-JSX lines." (save-excursion ;; Determine if inside a JSXElement. (beginning-of-line) ; For exclusivity - (when (setq tag-start-pos (js--outermost-enclosing-jsx-tag-pos)) + (when (setq tag-start-pos (js-jsx--outermost-enclosing-tag-pos)) ;; Check if inside an embedded multi-line JS expression. (goto-char current-pos) (end-of-line) ; For exclusivity @@ -2369,14 +2369,14 @@ Return nil for non-JSX lines." (setq parens (cdr parens))))) (or type 'n+1th))))) -(defun js--indent-line-in-jsx-expression () +(defun js-jsx--indent-line-in-expression () "Indent the current line as JavaScript within JSX." (let ((parse-status (save-excursion (syntax-ppss (point-at-bol)))) offset indent-col) (unless (nth 3 parse-status) (save-excursion (setq offset (- (point) (progn (back-to-indentation) (point))) - indent-col (js--as-sgml (sgml-calculate-indent)))) + indent-col (js-jsx--as-sgml (sgml-calculate-indent)))) (if (null indent-col) 'noindent ; Like in sgml-mode ;; Use whichever indentation column is greater, such that the ;; SGML column is effectively a minimum. @@ -2384,9 +2384,9 @@ Return nil for non-JSX lines." (+ indent-col js-indent-level))) (when (> offset 0) (forward-char offset)))))) -(defun js--indent-n+1th-jsx-line () +(defun js-jsx--indent-n+1th-line () "Indent the current line as JSX within JavaScript." - (js--as-sgml (sgml-indent-line))) + (js-jsx--as-sgml (sgml-indent-line))) (defun js-indent-line () "Indent the current line as JavaScript." @@ -2403,10 +2403,10 @@ Return nil for non-JSX lines." i.e., customize JSX element indentation with `sgml-basic-offset', `sgml-attribute-offset' et al." (interactive) - (let ((type (js--jsx-indentation))) + (let ((type (js-jsx--indentation-type))) (if type - (if (eq type 'n+1th) (js--indent-n+1th-jsx-line) - (js--indent-line-in-jsx-expression)) + (if (eq type 'n+1th) (js-jsx--indent-n+1th-line) + (js-jsx--indent-line-in-expression)) (js-indent-line)))) ;;; Filling From 52a3113b9beae6672c4bc981ee0c7bcc84ee58b5 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 17 Feb 2019 00:38:01 -0800 Subject: [PATCH 066/121] Add basic JSX font-locking MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Font-lock JSX from the beginning of the buffer to the end. Tends to break temporarily when editing lines, because the parser doesn’t yet look backwards to determine if the end of a tag in the current range starts before the range. This also re-breaks some tests fixed by previous commits, as we begin to take a different direction in our parsing code, looking for JSX, rather than for non-JSX. The parsing code will eventually provide information for indentation again. * lisp/progmodes/js.el (js--dotted-captured-name-re) (js-jsx--disambiguate-beginning-of-tag) (js-jsx--disambiguate-end-of-tag, js-jsx--disambiguate-syntax): Remove. (js-jsx--font-lock-keywords): New variable. (js--font-lock-keywords-3): Add JSX matchers. (js-jsx--match-tag-name, js-jsx--match-attribute-name): New functions. (js-jsx--syntax-propertize-tag): New function to aid in JSX font-locking and eventually indentation. (js-jsx--text-properties): New variable. (js-syntax-propertize): Propertize JSX properly using syntax-propertize-rules. --- lisp/progmodes/js.el | 214 +++++++++++++++++++++++++------------------ 1 file changed, 123 insertions(+), 91 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 4404ea04a03..1319fa19394 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -82,10 +82,6 @@ (concat js--name-re "\\(?:\\." js--name-re "\\)*") "Regexp matching a dot-separated sequence of JavaScript names.") -(defconst js--dotted-captured-name-re - (concat "\\(" js--name-re "\\)\\(?:\\." js--name-re "\\)*") - "Like `js--dotted-name-re', but capture the first name.") - (defconst js--cpp-name-re js--name-re "Regexp matching a C preprocessor name.") @@ -1498,6 +1494,33 @@ point of view of font-lock. It applies highlighting directly with ;; Matcher always "fails" nil) +(defconst js-jsx--font-lock-keywords + `((js-jsx--match-tag-name 0 font-lock-function-name-face t) + (js-jsx--match-attribute-name 0 font-lock-variable-name-face t)) + "JSX font lock faces.") + +(defun js-jsx--match-tag-name (limit) + "Match JSXBoundaryElement names, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-name nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-tag-name)) + (progn (set-match-data value) t)) + (js-jsx--match-tag-name limit)))))) + +(defun js-jsx--match-attribute-name (limit) + "Match JSXAttribute names, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-attribute-name nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-attribute-name)) + (progn (set-match-data value) t)) + (js-jsx--match-attribute-name limit)))))) + (defconst js--font-lock-keywords-3 `( ;; This goes before keywords-2 so it gets used preferentially @@ -1609,7 +1632,10 @@ point of view of font-lock. It applies highlighting directly with (forward-symbol -1) (end-of-line)) '(end-of-line) - '(0 font-lock-variable-name-face)))) + '(0 font-lock-variable-name-face))) + + ;; jsx (when enabled) + ,@js-jsx--font-lock-keywords) "Level three font lock for `js-mode'.") (defun js--inside-pitem-p (pitem) @@ -1743,94 +1769,100 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) -(defun js-jsx--disambiguate-beginning-of-tag () - "Parse enough to determine if a JSX tag starts here. -Disambiguate JSX from equality operators by testing for syntax -only valid as JSX." - ;; “” - a JSXOpeningFragment. - (if (memq (char-after) '(?\/ ?\>)) t - (save-excursion - (skip-chars-forward " \t\n") - (and - (looking-at js--dotted-captured-name-re) - ;; Don’t match code like “if (i < await foo)” - (not (js--unary-keyword-p (match-string 1))) - (progn - (goto-char (match-end 0)) - (skip-chars-forward " \t\n") - (or - ;; “>”, “/>” - tag enders. - ;; “{” - a JSXExpressionContainer. - (memq (char-after) '(?\> ?\/ ?\{)) - ;; Check if a JSXAttribute follows. - (looking-at js--name-start-re))))))) +(defun js-jsx--syntax-propertize-tag (end) + "Determine if a JSXBoundaryElement is before END and propertize it. +Disambiguate JSX from inequality operators and arrow functions by +testing for syntax only valid as JSX." + (let ((tag-beg (1- (point))) tag-end (type 'open) + name-beg name-match-data unambiguous + forward-sexp-function) ; Use Lisp version. + (catch 'stop + (while (and (< (point) end) + (progn (skip-chars-forward " \t\n" end) + (< (point) end))) + (cond + ((= (char-after) ?>) + (forward-char) + (setq unambiguous t + tag-end (point)) + (throw 'stop nil)) + ;; Handle a JSXSpreadChild (“= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + (if (= (char-after) ?}) (forward-char) ; Shortcut to bail. + ;; Recursively propertize the JSXExpressionContainer’s + ;; expression. + (js-syntax-propertize (point) (if expr-end (min (1- expr-end) end) end)) + ;; Exit the JSXExpressionContainer if that’s possible, + ;; else move to the end of the propertized area. + (goto-char (if expr-end (min expr-end end) end))))) + ((= (char-after) ?/) + ;; Assume a tag is an open tag until a slash is found, then + ;; figure out what type it actually is. + (if (eq type 'open) (setq type (if name-beg 'self-closing 'close))) + (forward-char)) + ((looking-at js--dotted-name-re) + (if (not name-beg) + (progn + ;; Don’t match code like “if (i < await foo)” + (if (js--unary-keyword-p (match-string 0)) (throw 'stop nil)) + ;; Save boundaries for later fontification after + ;; unambiguously determining the code is JSX. + (setq name-beg (match-beginning 0) + name-match-data (match-data)) + (goto-char (match-end 0))) + (setq unambiguous t) ; Non-unary name followed by 2nd name ⇒ JSX + ;; Save JSXAttribute’s name’s match data for font-locking later. + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) + 'js-jsx-attribute-name (match-data)) + (goto-char (match-end 0)) + (if (>= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + ;; “=” is optional for null-valued JSXAttributes. + (when (= (char-after) ?=) + (forward-char) + (if (>= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + ;; Skip over strings (if possible). Any + ;; JSXExpressionContainer here will be parsed in the + ;; next iteration of the loop. + (when (memq (char-after) '(?\" ?\' ?\`)) + (condition-case nil + (forward-sexp) + (scan-error (throw 'stop nil))))))) + ;; There is nothing more to check; this either isn’t JSX, or + ;; the tag is incomplete. + (t (throw 'stop nil))))) + (when unambiguous + ;; Save JSXBoundaryElement’s name’s match data for font-locking. + (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) + ;; Mark beginning and end of tag for features like indentation. + (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg type) + (if tag-end (put-text-property (1- tag-end) tag-end 'js-jsx-tag-end tag-beg))))) -(defun js-jsx--disambiguate-end-of-tag () - "Parse enough to determine if a JSX tag ends here. -Disambiguate JSX from equality operators by testing for syntax -only valid as JSX, or extremely unlikely except as JSX." - (save-excursion - (backward-char) - ;; “…/>” - a self-closing JSXOpeningElement. - ;; “” - a JSXClosingFragment. - (if (= (char-before) ?/) t - (let (last-tag-or-attr-name last-non-unary-p) - (catch 'match - (while t - (skip-chars-backward " \t\n") - ;; Check if the end of a JSXAttribute value or - ;; JSXExpressionContainer almost certainly precedes. - ;; The only valid JS this misses is - ;; - {} > foo - ;; - "bar" > foo - ;; which is no great loss, IMHO… - (if (memq (char-before) '(?\} ?\" ?\' ?\`)) (throw 'match t) - (if (and last-tag-or-attr-name last-non-unary-p - ;; “<”, “’ chars (from START to END) aren’t JSX. - -Later, this info prevents ‘sgml-’ functions from treating some -‘<’ and ‘>’ chars as parts of tokens of SGML tags — a good thing, -since they are serving their usual function as some JS equality -operator or arrow function, instead." - (goto-char start) - (while (re-search-forward "[<>]" end t) - (unless (if (eq (char-before) ?<) (js-jsx--disambiguate-beginning-of-tag) - (js-jsx--disambiguate-end-of-tag)) - ;; Inform sgml- functions that this >, >=, >>>, <, <=, <<<, or - ;; => token is punctuation (and not an open or close parenthesis - ;; as per usual in sgml-mode). - (put-text-property (1- (point)) (point) 'syntax-table '(1))))) +(defconst js-jsx--text-properties + '(js-jsx-tag-beg nil js-jsx-tag-end nil js-jsx-tag-name nil js-jsx-attribute-name nil) + "Plist of text properties added by `js-syntax-propertize'.") (defun js-syntax-propertize (start end) ;; JavaScript allows immediate regular expression objects, written /.../. (goto-char start) + (if js-jsx-syntax (remove-text-properties start end js-jsx--text-properties)) (js-syntax-propertize-regexp end) (funcall (syntax-propertize-rules @@ -1854,9 +1886,9 @@ operator or arrow function, instead." (put-text-property (match-beginning 1) (match-end 1) 'syntax-table (string-to-syntax "\"/")) (js-syntax-propertize-regexp end))))) - ("\\`\\(#\\)!" (1 "< b"))) - (point) end) - (if js-jsx-syntax (js-jsx--disambiguate-syntax start end))) + ("\\`\\(#\\)!" (1 "< b")) + ("<" (0 (ignore (if js-jsx-syntax (js-jsx--syntax-propertize-tag end)))))) + (point) end)) (defconst js--prettify-symbols-alist '(("=>" . ?⇒) From 4d2b5bbfebc040ca477f1156b44989b4e19bbc3e Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 17 Feb 2019 21:16:13 -0800 Subject: [PATCH 067/121] Font-lock JSX while editing it by extending regions * lisp/progmodes/js.el (js-jsx--font-lock-keywords): Call tag beginning and end matchers. (js-jsx--match-tag-beg, js-jsx--match-tag-end): New functions. (js-jsx--syntax-propertize-tag): Record buffer positions of JSXElement beginning and end for font-locking. (js--syntax-propertize-extend-region) (js-jsx--syntax-propertize-extend-region): New functions for extending the syntax-propertize region backwards to the start of a JSXElement so its JSXAttribute children on its n+1th lines can be parsed as such while editing those lines. (js-mode): Add js--syntax-propertize-extend-region to syntax-propertize-extend-region-functions. --- lisp/progmodes/js.el | 81 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 74 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1319fa19394..7fb4bcc808a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1496,8 +1496,10 @@ point of view of font-lock. It applies highlighting directly with (defconst js-jsx--font-lock-keywords `((js-jsx--match-tag-name 0 font-lock-function-name-face t) - (js-jsx--match-attribute-name 0 font-lock-variable-name-face t)) - "JSX font lock faces.") + (js-jsx--match-attribute-name 0 font-lock-variable-name-face t) + (js-jsx--match-tag-beg) + (js-jsx--match-tag-end)) + "JSX font lock faces and multiline text properties.") (defun js-jsx--match-tag-name (limit) "Match JSXBoundaryElement names, until LIMIT." @@ -1521,6 +1523,28 @@ point of view of font-lock. It applies highlighting directly with (progn (set-match-data value) t)) (js-jsx--match-attribute-name limit)))))) +(defun js-jsx--match-tag-beg (limit) + "Match JSXBoundaryElements from start, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-beg nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-tag-beg)) + (progn (put-text-property pos (cdr value) 'font-lock-multiline t) t)) + (js-jsx--match-tag-beg limit)))))) + +(defun js-jsx--match-tag-end (limit) + "Match JSXBoundaryElements from end, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-end nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-tag-end)) + (progn (put-text-property value pos 'font-lock-multiline t) t)) + (js-jsx--match-tag-end limit)))))) + (defconst js--font-lock-keywords-3 `( ;; This goes before keywords-2 so it gets used preferentially @@ -1769,11 +1793,53 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) +(defun js--syntax-propertize-extend-region (start end) + "Extend the START-END region for propertization, if necessary. +For use by `syntax-propertize-extend-region-functions'." + (if js-jsx-syntax (js-jsx--syntax-propertize-extend-region start end))) + +(defun js-jsx--syntax-propertize-extend-region (start end) + "Extend the START-END region for propertization, if necessary. +If any “>” in the region appears to be the end of a tag starting +before the start of the region, extend region backwards to the +start of that tag so parsing may proceed from that point. +For use by `syntax-propertize-extend-region-functions'." + (let (new-start + forward-sexp-function ; Use the Lisp version. + parse-sexp-lookup-properties) ; Fix backward-sexp error here. + (catch 'stop + (goto-char start) + (while (re-search-forward ">" end t) + (catch 'continue + ;; Check if this is really a right shift bitwise operator + ;; (“>>” or “>>>”). + (unless (or (eq (char-before (1- (point))) ?>) + (eq (char-after) ?>)) + (save-excursion + (backward-char) + (while (progn (if (= (point) (point-min)) (throw 'continue nil)) + (/= (char-before) ?<)) + (skip-chars-backward " \t\n") + (if (= (point) (point-min)) (throw 'continue nil)) + (cond + ((memq (char-before) '(?\" ?\' ?\` ?\})) + (condition-case nil + (backward-sexp) + (scan-error (throw 'continue nil)))) + ((memq (char-before) '(?\/ ?\=)) (backward-char)) + ((looking-back js--dotted-name-re (line-beginning-position) t) + (goto-char (match-beginning 0))) + (t (throw 'continue nil)))) + (when (< (point) start) + (setq new-start (1- (point))) + (throw 'stop nil))))))) + (if new-start (cons new-start end)))) + (defun js-jsx--syntax-propertize-tag (end) "Determine if a JSXBoundaryElement is before END and propertize it. Disambiguate JSX from inequality operators and arrow functions by testing for syntax only valid as JSX." - (let ((tag-beg (1- (point))) tag-end (type 'open) + (let ((tag-beg (1- (point))) (type 'open) name-beg name-match-data unambiguous forward-sexp-function) ; Use Lisp version. (catch 'stop @@ -1783,8 +1849,7 @@ testing for syntax only valid as JSX." (cond ((= (char-after) ?>) (forward-char) - (setq unambiguous t - tag-end (point)) + (setq unambiguous t) (throw 'stop nil)) ;; Handle a JSXSpreadChild (“ Date: Fri, 8 Mar 2019 16:29:02 -0800 Subject: [PATCH 068/121] Propertize and font-lock JSXText and JSXExpressionContainers This completes highlighting support for JSX, as requested in: - https://github.com/mooz/js2-mode/issues/140 - https://github.com/mooz/js2-mode/issues/330 - https://github.com/mooz/js2-mode/issues/409 * lisp/progmodes/js.el (js--name-start-chars): Extract part of js--name-start-re so it can be reused in another regexp. (js--name-start-re): Use js--name-start-chars. (js-jsx--font-lock-keywords): Use new matchers. (js-jsx--match-text, js-jsx--match-expr): New matchers to remove typical JS font-locking and extend the font-locked region, respectively. (js-jsx--tag-re, js-jsx--self-closing-re): New regexps matching JSX. (js-jsx--matched-tag-type, js-jsx--matching-close-tag-pos) (js-jsx--enclosing-curly-pos, js-jsx--enclosing-tag-pos) (js-jsx--at-enclosing-tag-child-p): New functions for parsing and analyzing JSX. (js-jsx--text-range, js-jsx--syntax-propertize-tag-text): New functions for propertizing JSXText. (js-jsx--syntax-propertize-tag): Propertize JSXText children of tags. (js-jsx--text-properties): Remove JSXText-related text properties when repropertizing. (js-mode): Extend the syntax-propertize region with syntax-propertize-multiline; we are now adding the syntax-multiline text property to buffer ranges that are JSXText to ensure the whole multiline JSX construct is reidentified. --- lisp/progmodes/js.el | 216 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 211 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 7fb4bcc808a..220cf97fdca 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -66,7 +66,10 @@ ;;; Constants -(defconst js--name-start-re "[a-zA-Z_$]" +(defconst js--name-start-chars "a-zA-Z_$" + "Character class chars matching the start of a JavaScript identifier.") + +(defconst js--name-start-re (concat "[" js--name-start-chars "]") "Regexp matching the start of a JavaScript identifier, without grouping.") (defconst js--stmt-delim-chars "^;{}?:") @@ -1497,8 +1500,10 @@ point of view of font-lock. It applies highlighting directly with (defconst js-jsx--font-lock-keywords `((js-jsx--match-tag-name 0 font-lock-function-name-face t) (js-jsx--match-attribute-name 0 font-lock-variable-name-face t) + (js-jsx--match-text 0 'default t) ; “Undo” keyword fontification. (js-jsx--match-tag-beg) - (js-jsx--match-tag-end)) + (js-jsx--match-tag-end) + (js-jsx--match-expr)) "JSX font lock faces and multiline text properties.") (defun js-jsx--match-tag-name (limit) @@ -1523,6 +1528,19 @@ point of view of font-lock. It applies highlighting directly with (progn (set-match-data value) t)) (js-jsx--match-attribute-name limit)))))) +(defun js-jsx--match-text (limit) + "Match JSXText, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-text nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-text)) + (progn (set-match-data value) + (put-text-property (car value) (cadr value) 'font-lock-multiline t) + t)) + (js-jsx--match-text limit)))))) + (defun js-jsx--match-tag-beg (limit) "Match JSXBoundaryElements from start, until LIMIT." (when js-jsx-syntax @@ -1545,6 +1563,17 @@ point of view of font-lock. It applies highlighting directly with (progn (put-text-property value pos 'font-lock-multiline t) t)) (js-jsx--match-tag-end limit)))))) +(defun js-jsx--match-expr (limit) + "Match JSXExpressionContainers, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-expr nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-expr)) + (progn (put-text-property pos value 'font-lock-multiline t) t)) + (js-jsx--match-expr limit)))))) + (defconst js--font-lock-keywords-3 `( ;; This goes before keywords-2 so it gets used preferentially @@ -1835,6 +1864,177 @@ For use by `syntax-propertize-extend-region-functions'." (throw 'stop nil))))))) (if new-start (cons new-start end)))) +(defconst js-jsx--tag-re + (concat "<\\s-*\\(" + "[/>]" ; JSXClosingElement, or JSXOpeningFragment, or JSXClosingFragment + "\\|" + js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]" ; JSXOpeningElement + "\\)") + "Regexp unambiguously matching a JSXBoundaryElement.") + +(defun js-jsx--matched-tag-type () + "Determine the tag type of the last match to `js-jsx--tag-re'. +Return `close' for a JSXClosingElement/JSXClosingFragment match, +return `self-closing' for some self-closing JSXOpeningElements, +else return `other'." + (let ((chars (vconcat (match-string 1)))) + (cond + ((= (aref chars 0) ?/) 'close) + ((= (aref chars (1- (length chars))) ?/) 'self-closing) + (t 'other)))) + +(defconst js-jsx--self-closing-re "/\\s-*>" + "Regexp matching the end of a self-closing JSXOpeningElement.") + +(defun js-jsx--matching-close-tag-pos () + "Return position of the closer of the opener before point. +Assuming a JSXOpeningElement or a JSXOpeningFragment is +immediately before point, find a matching JSXClosingElement or +JSXClosingFragment, skipping over any nested JSXElements to find +the match. Return nil if a match can’t be found." + (let ((tag-stack 1) self-closing-pos type) + (catch 'stop + (while (re-search-forward js-jsx--tag-re nil t) + (setq type (js-jsx--matched-tag-type)) + ;; Balance the total of self-closing tags that we subtract + ;; from the stack, ignoring those tags which are never added + ;; to the stack (see below). + (unless (eq type 'self-closing) + (when (and self-closing-pos (> (point) self-closing-pos)) + (setq tag-stack (1- tag-stack)))) + (if (eq type 'close) + (progn + (setq tag-stack (1- tag-stack)) + (when (= tag-stack 0) + (throw 'stop (match-beginning 0)))) + ;; Tags that we know are self-closing aren’t added to the + ;; stack at all, because we only close the ones that we have + ;; anticipated after moving past those anticipated tags’ + ;; ends, and if a self-closing tag is the first tag we + ;; encounter in this loop, then it will never be anticipated + ;; (due to an optimization where we sometimes can avoid + ;; looking for self-closing tags). + (unless (eq type 'self-closing) + (setq tag-stack (1+ tag-stack)))) + ;; Don’t needlessly recalculate. + (unless (and self-closing-pos (<= (point) self-closing-pos)) + (setq self-closing-pos nil) ; Reset if recalculating. + (save-excursion + ;; Anticipate a self-closing tag that we should make sure + ;; to subtract from the tag stack once we move past its + ;; end; we might might miss the end otherwise, due to the + ;; regexp-matching method we use to detect tags. + (when (re-search-forward js-jsx--self-closing-re nil t) + (setq self-closing-pos (match-beginning 0))))))))) + +(defun js-jsx--enclosing-curly-pos () + "Return position of enclosing “{” in a “{/}” pair about point." + (let ((parens (reverse (nth 9 (syntax-ppss)))) paren-pos curly-pos) + (while + (and + (setq paren-pos (car parens)) + (not (when (= (char-after paren-pos) ?{) + (setq curly-pos paren-pos))) + (setq parens (cdr parens)))) + curly-pos)) + +(defun js-jsx--enclosing-tag-pos () + "Return beginning and end of a JSXElement about point. +Look backward for a JSXElement that both starts before point and +also ends after point. That may be either a self-closing +JSXElement or a JSXOpeningElement/JSXClosingElement pair." + (let ((start (point)) + (curly-pos (save-excursion (js-jsx--enclosing-curly-pos))) + tag-beg tag-beg-pos tag-end-pos close-tag-pos) + (while + (and + (setq tag-beg (js--backward-text-property 'js-jsx-tag-beg)) + (progn + (setq tag-beg-pos (point) + tag-end-pos (cdr tag-beg)) + (not + (or + (and (eq (car tag-beg) 'self-closing) + (< start tag-end-pos)) + (and (eq (car tag-beg) 'open) + (save-excursion + (goto-char tag-end-pos) + (setq close-tag-pos (js-jsx--matching-close-tag-pos)) + ;; The JSXOpeningElement may either be unclosed, + ;; else the closure must occur after the start + ;; point (otherwise, a miscellaneous previous + ;; JSXOpeningElement has been found, and we should + ;; keep looking back for an enclosing one). + (or (not close-tag-pos) (< start close-tag-pos)))))))) + ;; Don’t return the last tag pos (if any; it wasn’t enclosing). + (setq tag-beg nil)) + (and tag-beg + (or (not curly-pos) (> tag-beg-pos curly-pos)) + (cons tag-beg-pos tag-end-pos)))) + +(defun js-jsx--at-enclosing-tag-child-p () + "Return t if point is at an enclosing tag’s child." + (let ((pos (save-excursion (js-jsx--enclosing-tag-pos)))) + (and pos (>= (point) (cdr pos))))) + +(defun js-jsx--text-range (beg end) + "Identify JSXText within a “>/{/}/<” pair." + (when (> (- end beg) 0) + (save-excursion + (goto-char beg) + (while (and (skip-chars-forward " \t\n" end) (< (point) end)) + ;; Comments and string quotes don’t serve their usual + ;; syntactic roles in JSXText; make them plain punctuation to + ;; negate those roles. + (when (or (= (char-after) ?/) ; comment + (= (syntax-class (syntax-after (point))) 7)) ; string quote + (put-text-property (point) (1+ (point)) 'syntax-table '(1))) + (forward-char))) + ;; Mark JSXText so it can be font-locked as non-keywords. + (put-text-property beg (1+ beg) 'js-jsx-text (list beg end (current-buffer))) + ;; Ensure future propertization beginning from within the + ;; JSXText determines JSXText context from earlier lines. + (put-text-property beg end 'syntax-multiline t))) + +(defun js-jsx--syntax-propertize-tag-text (end) + "Determine if JSXText is before END and propertize it. +Text within an open/close tag pair may be JSXText. Temporarily +interrupt JSXText by JSXExpressionContainers, and terminate +JSXText when another JSXBoundaryElement is encountered. Despite +terminations, all JSXText will be identified once all the +JSXBoundaryElements within an outermost JSXElement’s tree have +been propertized." + (let ((text-beg (point)) + forward-sexp-function) ; Use Lisp version. + (catch 'stop + (while (re-search-forward "[{<]" end t) + (js-jsx--text-range text-beg (1- (point))) + (cond + ((= (char-before) ?{) + (let (expr-beg expr-end) + (condition-case nil + (save-excursion + (backward-char) + (setq expr-beg (point)) + (forward-sexp) + (setq expr-end (point))) + (scan-error nil)) + ;; Recursively propertize the JSXExpressionContainer’s + ;; (possibly-incomplete) expression. + (js-syntax-propertize (1+ expr-beg) (if expr-end (min (1- expr-end) end) end)) + ;; Ensure future propertization beginning from within the + ;; (possibly-incomplete) expression can determine JSXText + ;; context from earlier lines. + (put-text-property expr-beg (1+ expr-beg) 'js-jsx-expr (or expr-end end)) ; font-lock + (put-text-property expr-beg (if expr-end (min expr-end end) end) 'syntax-multiline t) ; syntax-propertize + ;; Exit the JSXExpressionContainer if that’s possible, + ;; else move to the end of the propertized area. + (goto-char (if expr-end (min expr-end end) end)))) + ((= (char-before) ?<) + (backward-char) ; Ensure the next tag can be propertized. + (throw 'stop nil))) + (setq text-beg (point)))))) + (defun js-jsx--syntax-propertize-tag (end) "Determine if a JSXBoundaryElement is before END and propertize it. Disambiguate JSX from inequality operators and arrow functions by @@ -1916,12 +2116,16 @@ testing for syntax only valid as JSX." (when unambiguous ;; Save JSXBoundaryElement’s name’s match data for font-locking. (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) - ;; Mark beginning and end of tag for features like indentation. + ;; Mark beginning and end of tag for font-locking. (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg (cons type (point))) - (put-text-property (point) (1+ (point)) 'js-jsx-tag-end tag-beg)))) + (put-text-property (point) (1+ (point)) 'js-jsx-tag-end tag-beg)) + (if (js-jsx--at-enclosing-tag-child-p) (js-jsx--syntax-propertize-tag-text end)))) (defconst js-jsx--text-properties - '(js-jsx-tag-beg nil js-jsx-tag-end nil js-jsx-tag-name nil js-jsx-attribute-name nil) + (list + 'js-jsx-tag-beg nil 'js-jsx-tag-end nil + 'js-jsx-tag-name nil 'js-jsx-attribute-name nil + 'js-jsx-text nil 'js-jsx-expr nil) "Plist of text properties added by `js-syntax-propertize'.") (defun js-syntax-propertize (start end) @@ -4010,6 +4214,8 @@ If one hasn't been set, or if it's stale, prompt for a new one." '(font-lock-syntactic-face-function . js-font-lock-syntactic-face-function))) (setq-local syntax-propertize-function #'js-syntax-propertize) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) (add-hook 'syntax-propertize-extend-region-functions #'js--syntax-propertize-extend-region 'append 'local) (setq-local prettify-symbols-alist js--prettify-symbols-alist) From 2bedd23358d2d7378eec78d526ba1435d3b4d122 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sat, 23 Mar 2019 12:33:20 -0700 Subject: [PATCH 069/121] Update expectations for JSX indentation in JSXAttribute space * test/manual/indent/js-jsx.js: Align expectations for dangling closing constructs with other places in the tests. --- test/manual/indent/js-jsx.js | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js index af3c3405590..2ec00c63bbd 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/js-jsx.js @@ -37,7 +37,7 @@ return ( React.render( , + />, { a: 1 } @@ -242,12 +242,18 @@ export default ({ stars }) => ( // JS expressions should not break indentation // (https://github.com/mooz/js2-mode/issues/462). +// +// In the referenced issue, the user actually wanted indentation which +// was simply different than Emacs’ SGML attribute indentation. +// Nevertheless, his issue highlighted our inability to properly +// indent code with JSX inside JSXExpressionContainers inside JSX. return ( - ( -
nothing
- )} /> + ( +
nothing
+ )} /> From 1a1ef2851844a9ae2edcfe0346fc457e90c24bc7 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sat, 23 Mar 2019 14:22:35 -0700 Subject: [PATCH 070/121] Indent JSX as parsed in a JS context MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes the following issues (and re-fixes indentation issues initially fixed but later re-broken by previous commits in the process of adding comprehensive JSX support): - https://github.com/mooz/js2-mode/issues/389#issuecomment-390766873 - https://github.com/mooz/js2-mode/issues/482 - Bug#32158 - https://github.com/mooz/js2-mode/issues/462 Previously, we delegated to sgml-mode functions for JSX indentation. However, there were some problems with this approach: - sgml-mode does not anticipate tags inside attributes when indenting, which compromises JSX indentation inside JSXExpressionContainers inside JSXAttributes. - In previous iterations to provide comprehensive JSX support, it proved tedious to disambiguate “<” and “>” as JS inequality operators and arrow functions from opening and closing angle brackets as part of SGML tags. That code evolved into a more complete JSX parsing implementation for syntax-propertize rules for font-locking, discarding the superfluous “<”/“>” disambiguation in anticipation of using the improved JSX analysis for indentation. - Using sgml-mode functions, we controlled JSX indentation using SGML variables. However, JSX is a different thing than SGML; referencing SGML in JS was a leaky abstraction. To resolve these issues, use the text properties added by the JSX syntax-propertize code to determine the boundaries of various aspects of JSX syntax, and reimplement the sgml-mode indentation code in js-mode with better respect to JSX indentation conventions. * lisp/progmodes/js.el (js-jsx-attribute-offset): New variable to provide a way for users to still control JSX attribute offsets as they could with sgml-attribute-offset before. The value of this feature is dubious IMO, but it’s trivial to keep it, so let’s do it just in case. (js-jsx--goto-outermost-enclosing-curly): New function. (js-jsx--enclosing-tag-pos): Refactor to be unbounded by curlies, so this function can be used to find JSXExpressionContainers within JSX. Fix bug where an enclosing JSXElement couldn’t be found when point was at the start of its JSXClosingElement. Return the JSXClosingElement’s position as well, so the JSXClosingElement can be indentified when indenting and be indented like the matching JSXOpeningElement. (js-jsx--at-enclosing-tag-child-p): js-jsx--enclosing-tag-pos now returns a list rather than a cons, so retrieve the JSXOpeningElement’s end position from a list. (js-jsx--context, js-jsx--indenting): New function and variable. (js-jsx--indentation): New function replacing the prior js-jsx--indent* functions and js-jsx-indent-line’s implementation. Use the JSX parsing performed in a JS context to more accurately calculate JSX indentation than by delegating to sgml-mode functions. (js--proper-indentation): Use js-jsx--indentation as yet another type of indentation. (js-jsx--as-sgml, js-jsx--outermost-enclosing-tag-pos) (js-jsx--indentation-type, js-jsx--indent-line-in-expression) (js-jsx--indent-n+1th-line): Remove obsolete functions. (js-jsx-indent-line): Refactor nearly-obsolete function to behave the same as it usually would before these changes, without respect to the binding of js-jsx-syntax. (js-jsx-mode): Remove obsolete documentation about the use of SGML variables to control indentation, and don’t bind indent-line-function any more, because it is no longer necessary given the new implementation of js-jsx-indent-line. --- lisp/progmodes/js.el | 307 +++++++++++++++++++++++-------------------- 1 file changed, 165 insertions(+), 142 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 220cf97fdca..af83e04df42 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -584,6 +584,29 @@ be buffer-local when in `js-jsx-mode'." :safe 'booleanp :group 'js) +(defcustom js-jsx-attribute-offset 0 + "Specifies a delta for JSXAttribute indentation. + +Let `js-indent-level' be 2. When this variable is also set to 0, +JSXAttribute indentation looks like this: + + + + +Alternatively, when this variable is also set to 2, JSXAttribute +indentation looks like this: + + + + +This variable is like `sgml-attribute-offset'." + :version "27.1" + :type 'integer + :safe 'integerp + :group 'js) + ;;; KeyMap (defvar js-mode-map @@ -1938,14 +1961,21 @@ the match. Return nil if a match can’t be found." (setq parens (cdr parens)))) curly-pos)) +(defun js-jsx--goto-outermost-enclosing-curly (limit) + "Set point to enclosing “{” at or closest after LIMIT." + (let (pos) + (while + (and + (setq pos (js-jsx--enclosing-curly-pos)) + (if (>= pos limit) (goto-char pos)) + (> pos limit))))) + (defun js-jsx--enclosing-tag-pos () "Return beginning and end of a JSXElement about point. Look backward for a JSXElement that both starts before point and also ends after point. That may be either a self-closing JSXElement or a JSXOpeningElement/JSXClosingElement pair." - (let ((start (point)) - (curly-pos (save-excursion (js-jsx--enclosing-curly-pos))) - tag-beg tag-beg-pos tag-end-pos close-tag-pos) + (let ((start (point)) tag-beg tag-beg-pos tag-end-pos close-tag-pos) (while (and (setq tag-beg (js--backward-text-property 'js-jsx-tag-beg)) @@ -1957,25 +1987,24 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." (and (eq (car tag-beg) 'self-closing) (< start tag-end-pos)) (and (eq (car tag-beg) 'open) - (save-excursion - (goto-char tag-end-pos) - (setq close-tag-pos (js-jsx--matching-close-tag-pos)) - ;; The JSXOpeningElement may either be unclosed, - ;; else the closure must occur after the start - ;; point (otherwise, a miscellaneous previous - ;; JSXOpeningElement has been found, and we should - ;; keep looking back for an enclosing one). - (or (not close-tag-pos) (< start close-tag-pos)))))))) - ;; Don’t return the last tag pos (if any; it wasn’t enclosing). - (setq tag-beg nil)) - (and tag-beg - (or (not curly-pos) (> tag-beg-pos curly-pos)) - (cons tag-beg-pos tag-end-pos)))) + (or (< start tag-end-pos) + (save-excursion + (goto-char tag-end-pos) + (setq close-tag-pos (js-jsx--matching-close-tag-pos)) + ;; The JSXOpeningElement may be unclosed, else + ;; the closure must occur at/after the start + ;; point (otherwise, a miscellaneous previous + ;; JSXOpeningElement has been found, so keep + ;; looking backwards for an enclosing one). + (or (not close-tag-pos) (<= start close-tag-pos))))))))) + ;; Don’t return the last tag pos, as it wasn’t enclosing. + (setq tag-beg nil close-tag-pos nil)) + (and tag-beg (list tag-beg-pos tag-end-pos close-tag-pos)))) (defun js-jsx--at-enclosing-tag-child-p () "Return t if point is at an enclosing tag’s child." (let ((pos (save-excursion (js-jsx--enclosing-tag-pos)))) - (and pos (>= (point) (cdr pos))))) + (and pos (>= (point) (nth 1 pos))))) (defun js-jsx--text-range (beg end) "Identify JSXText within a “>/{/}/<” pair." @@ -2515,6 +2544,118 @@ current line is the \"=>\" token." (t (looking-at-p (concat js--name-re js--line-terminating-arrow-re))))) +(defun js-jsx--context () + "Determine JSX context and move to enclosing JSX." + (let ((pos (point)) + (parse-status (syntax-ppss)) + (enclosing-tag-pos (js-jsx--enclosing-tag-pos))) + (when enclosing-tag-pos + (if (< pos (nth 1 enclosing-tag-pos)) + (if (nth 3 parse-status) + (list 'string (nth 8 parse-status)) + (list 'tag (nth 0 enclosing-tag-pos) (nth 1 enclosing-tag-pos))) + (list 'text (nth 0 enclosing-tag-pos) (nth 2 enclosing-tag-pos)))))) + +(defvar js-jsx--indenting nil + "Flag to prevent infinite recursion while indenting JSX.") + +(defun js-jsx--indentation (parse-status) + "Helper function for `js--proper-indentation'. +Return the proper indentation of the current line if it is part +of a JSXElement expression spanning multiple lines; otherwise, +return nil." + (let ((current-line (line-number-at-pos)) + (curly-pos (js-jsx--enclosing-curly-pos)) + nth-context context expr-p beg-line col + forward-sexp-function) ; Use the Lisp version. + ;; Find the immediate context for indentation information, but + ;; keep going to determine that point is at the N+1th line of + ;; multiline JSX. + (save-excursion + (while + (and + (setq nth-context (js-jsx--context)) + (progn + (unless context + (setq context nth-context) + (setq expr-p (and curly-pos (< (point) curly-pos)))) + (setq beg-line (line-number-at-pos)) + (and + (= beg-line current-line) + (or (not curly-pos) (> (point) curly-pos))))))) + (when (and context (> current-line beg-line)) + (save-excursion + ;; The column calculation is based on `sgml-calculate-indent'. + (setq col (pcase (nth 0 context) + + ('string + ;; Go back to previous non-empty line. + (while (and (> (point) (nth 1 context)) + (zerop (forward-line -1)) + (looking-at "[ \t]*$"))) + (if (> (point) (nth 1 context)) + ;; Previous line is inside the string. + (current-indentation) + (goto-char (nth 1 context)) + (1+ (current-column)))) + + ('tag + ;; Special JSX indentation rule: a “dangling” + ;; closing angle bracket on its own line is + ;; indented at the same level as the opening + ;; angle bracket of the JSXElement. Otherwise, + ;; indent JSXAttribute space like SGML. + (if (progn + (goto-char (nth 2 context)) + (and (= current-line (line-number-at-pos)) + (looking-back "^\\s-*/?>" (line-beginning-position)))) + (progn + (goto-char (nth 1 context)) + (current-column)) + ;; Indent JSXAttribute space like SGML. + (goto-char (nth 1 context)) + ;; Skip tag name: + (skip-chars-forward " \t") + (skip-chars-forward "^ \t\n") + (skip-chars-forward " \t") + (if (not (eolp)) + (current-column) + ;; This is the first attribute: indent. + (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) + (+ (current-column) js-indent-level)))) + + ('text + ;; Indent to reflect nesting. + (goto-char (nth 1 context)) + (+ (current-column) + ;; The last line isn’t nested, but the rest are. + (if (or (not (nth 2 context)) ; Unclosed. + (< current-line (line-number-at-pos (nth 2 context)))) + js-indent-level + 0))) + + ))) + ;; When indenting a JSXExpressionContainer expression, use JSX + ;; indentation as a minimum, and use regular JS indentation if + ;; it’s deeper. + (if expr-p + (max (+ col + ;; An expression in a JSXExpressionContainer in a + ;; JSXAttribute should be indented more, except on + ;; the ending line of the JSXExpressionContainer. + (if (and (eq (nth 0 context) 'tag) + (< current-line + (save-excursion + (js-jsx--goto-outermost-enclosing-curly + (nth 1 context)) + (forward-sexp) + (line-number-at-pos)))) + js-indent-level + 0)) + (let ((js-jsx--indenting t)) ; Prevent recursion. + (js--proper-indentation parse-status))) + col)))) + (defun js--proper-indentation (parse-status) "Return the proper indentation for the current line." (save-excursion @@ -2522,6 +2663,8 @@ current line is the \"=>\" token." (cond ((nth 4 parse-status) ; inside comment (js--get-c-offset 'c (nth 8 parse-status))) ((nth 3 parse-status) 0) ; inside string + ((when (and js-jsx-syntax (not js-jsx--indenting)) + (save-excursion (js-jsx--indentation parse-status)))) ((eq (char-after) ?#) 0) ((save-excursion (js--beginning-of-macro)) 4) ;; Indent array comprehension continuation lines specially. @@ -2584,111 +2727,6 @@ current line is the \"=>\" token." (+ js-indent-level js-expr-indent-offset)) (t (prog-first-column))))) -;;; JSX Indentation - -(defmacro js-jsx--as-sgml (&rest body) - "Execute BODY as if in sgml-mode." - `(with-syntax-table sgml-mode-syntax-table - ,@body)) - -(defun js-jsx--outermost-enclosing-tag-pos () - (let (context tag-pos last-tag-pos parse-status parens paren-pos curly-pos) - (js-jsx--as-sgml - ;; Search until we reach the top or encounter the start of a - ;; JSXExpressionContainer (implying nested JSX). - (while (and (setq context (sgml-get-context)) - (progn - (setq tag-pos (sgml-tag-start (car (last context)))) - (or (not curly-pos) - ;; Stop before curly brackets (start of a - ;; JSXExpressionContainer). - (> tag-pos curly-pos)))) - ;; Record this position so it can potentially be returned. - (setq last-tag-pos tag-pos) - ;; Always parse sexps / search for the next context from the - ;; immediately enclosing tag (sgml-get-context may not leave - ;; point there). - (goto-char tag-pos) - (unless parse-status ; Don’t needlessly reparse. - ;; Search upward for an enclosing starting curly bracket. - (setq parse-status (syntax-ppss)) - (setq parens (reverse (nth 9 parse-status))) - (while (and (setq paren-pos (car parens)) - (not (when (= (char-after paren-pos) ?{) - (setq curly-pos paren-pos)))) - (setq parens (cdr parens))) - ;; Always search for the next context from the immediately - ;; enclosing tag (calling syntax-ppss in the above loop - ;; may move point from there). - (goto-char tag-pos)))) - last-tag-pos)) - -(defun js-jsx--indentation-type () - "Determine if/how the current line should be indented as JSX. - -Return nil for first JSXElement line (indent like JS). -Return `n+1th' for second+ JSXElement lines (indent like SGML). -Return `expression' for lines within embedded JS expressions - (indent like JS inside SGML). -Return nil for non-JSX lines." - (let ((current-pos (point)) - (current-line (line-number-at-pos)) - tag-start-pos parens paren type) - (save-excursion - ;; Determine if inside a JSXElement. - (beginning-of-line) ; For exclusivity - (when (setq tag-start-pos (js-jsx--outermost-enclosing-tag-pos)) - ;; Check if inside an embedded multi-line JS expression. - (goto-char current-pos) - (end-of-line) ; For exclusivity - (setq parens (nth 9 (syntax-ppss))) - (while - (and - (setq paren (car parens)) - (if (and - (>= paren tag-start-pos) - ;; A curly bracket indicates the start of an - ;; embedded expression. - (= (char-after paren) ?{) - ;; The first line of the expression is indented - ;; like SGML. - (> current-line (line-number-at-pos paren)) - ;; Check if within a closing curly bracket (if any) - ;; (exclusive, as the closing bracket is indented - ;; like SGML). - (if (progn - (goto-char paren) - (ignore-errors (let (forward-sexp-function) - (forward-sexp)))) - (< current-line (line-number-at-pos)) - ;; No matching bracket implies we’re inside! - t)) - ;; Indicate this will be indented specially. Return - ;; nil to stop iterating too. - (progn (setq type 'expression) nil) - ;; Stop iterating when parens = nil. - (setq parens (cdr parens))))) - (or type 'n+1th))))) - -(defun js-jsx--indent-line-in-expression () - "Indent the current line as JavaScript within JSX." - (let ((parse-status (save-excursion (syntax-ppss (point-at-bol)))) - offset indent-col) - (unless (nth 3 parse-status) - (save-excursion - (setq offset (- (point) (progn (back-to-indentation) (point))) - indent-col (js-jsx--as-sgml (sgml-calculate-indent)))) - (if (null indent-col) 'noindent ; Like in sgml-mode - ;; Use whichever indentation column is greater, such that the - ;; SGML column is effectively a minimum. - (indent-line-to (max (js--proper-indentation parse-status) - (+ indent-col js-indent-level))) - (when (> offset 0) (forward-char offset)))))) - -(defun js-jsx--indent-n+1th-line () - "Indent the current line as JSX within JavaScript." - (js-jsx--as-sgml (sgml-indent-line))) - (defun js-indent-line () "Indent the current line as JavaScript." (interactive) @@ -2700,15 +2738,9 @@ Return nil for non-JSX lines." (when (> offset 0) (forward-char offset))))) (defun js-jsx-indent-line () - "Indent the current line as JSX (with SGML offsets). -i.e., customize JSX element indentation with `sgml-basic-offset', -`sgml-attribute-offset' et al." + "Indent the current line as JavaScript+JSX." (interactive) - (let ((type (js-jsx--indentation-type))) - (if type - (if (eq type 'n+1th) (js-jsx--indent-n+1th-line) - (js-jsx--indent-line-in-expression)) - (js-indent-line)))) + (let ((js-jsx-syntax t)) (js-indent-line))) ;;; Filling @@ -4281,18 +4313,9 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;;;###autoload (define-derived-mode js-jsx-mode js-mode "JSX" - "Major mode for editing JSX. - -To customize the indentation for this mode, set the SGML offset -variables (`sgml-basic-offset', `sgml-attribute-offset' et al.) -locally, like so: - - (defun set-jsx-indentation () - (setq-local sgml-basic-offset js-indent-level)) - (add-hook \\='js-jsx-mode-hook #\\='set-jsx-indentation)" + "Major mode for editing JSX." :group 'js - (setq-local js-jsx-syntax t) - (setq-local indent-line-function #'js-jsx-indent-line)) + (setq-local js-jsx-syntax t)) ;;;###autoload (defalias 'javascript-mode 'js-mode) From 339be7c00790fb407cc8449fa8f59baa792cbe69 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sat, 23 Mar 2019 15:01:55 -0700 Subject: [PATCH 071/121] =?UTF-8?q?Finish=20replacing=20SGML-based=20JSX?= =?UTF-8?q?=20detection=20with=20js-mode=E2=80=99s=20parsing?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This removes the last dependency on sgml-mode for JSX-related logic. * lisp/progmodes/js.el (js-jsx--start-tag-re) (js-jsx--end-tag-re): Remove. (js-jsx--looking-at-start-tag-p) (js-jsx--looking-back-at-end-tag-p): Reimplement using text properties, using syntax information which ought to be slightly more accurate than regexps since it was found by complete parsing. --- lisp/progmodes/js.el | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index af83e04df42..df2c41332e7 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -50,7 +50,6 @@ (require 'imenu) (require 'moz nil t) (require 'json) -(require 'sgml-mode) (require 'prog-mode) (eval-when-compile @@ -2211,13 +2210,10 @@ testing for syntax only valid as JSX." (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") -(defconst js-jsx--start-tag-re - (concat "<" sgml-name-re) - "Regexp matching code that looks like a JSXOpeningElement.") - (defun js-jsx--looking-at-start-tag-p () "Non-nil if a JSXOpeningElement immediately follows point." - (looking-at js-jsx--start-tag-re)) + (let ((tag-beg (get-text-property (point) 'js-jsx-tag-beg))) + (and tag-beg (memq (car tag-beg) '(open self-closing))))) (defun js--looking-at-operator-p () "Return non-nil if point is on a JavaScript operator, other than a comma." @@ -2263,13 +2259,9 @@ testing for syntax only valid as JSX." (setq result nil))) result)) -(defconst js-jsx--end-tag-re - (concat "\\|/>") - "Regexp matching a JSXClosingElement.") - (defun js-jsx--looking-back-at-end-tag-p () "Non-nil if a JSXClosingElement immediately precedes point." - (looking-back js-jsx--end-tag-re (point-at-bol))) + (get-text-property (point) 'js-jsx-tag-end)) (defun js--continued-expression-p () "Return non-nil if the current line continues an expression." From bf37078df2cbea3a44a641ddbe40f11339c135a2 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sat, 23 Mar 2019 20:14:29 -0700 Subject: [PATCH 072/121] Automatically detect JSX in JavaScript files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/files.el (auto-mode-alist): Simply enable javascript-mode (js-mode) when opening “.jsx” files, since the “.jsx” file extension will be used as an indicator of JSX syntax by js-mode, and more code is likely to work in js-mode than js-jsx-mode, and we probably want to guide users to use js-mode (with js-jsx-syntax) instead. Code that used to work exclusively in js-jsx-mode (if anyone ever wrote any) ought to be updated to work in js-mode too when js-jsx-syntax is set to t. * lisp/progmodes/js.el (js-jsx-detect-syntax, js-jsx-regexps) (js-jsx--detect-and-enable, js-jsx--detect-after-change): New variables and functions for detecting and enabling JSX. (js-jsx-syntax): Update docstring with respect to the widened scope of the effects and use of this variable. (js-syntactic-mode-name, js--update-mode-name) (js--idly-update-mode-name, js-jsx-enable): New variable and functions for indicating when JSX is enabled. (js-mode): Detect and enable JSX. Print all enabled syntaxes after the mode name whenever Emacs goes idle; this ensures lately-enabled syntaxes are evident. (js-jsx-mode): Update mode name for consistency with the state in which JSX is enabled in js-mode. Update docstring to suggest alternative means of using JSX without this mode. Going forward, it may be best to gently guide users away from js-jsx-mode, since a “one mode per syntax extension” model would not scale well if more syntax extensions were to be simultaneously supported (e.g. Facebook’s “Flow”). --- lisp/files.el | 3 +- lisp/progmodes/js.el | 119 +++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 115 insertions(+), 7 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 1dae57593a0..b81550e297c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2705,9 +2705,8 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo ("\\.dbk\\'" . xml-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.jsm?\\'" . javascript-mode) + ("\\.js[mx]?\\'" . javascript-mode) ("\\.json\\'" . javascript-mode) - ("\\.jsx\\'" . js-jsx-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ("\\.wy\\'" . wisent-grammar-mode) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index df2c41332e7..0bba8159c18 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -574,10 +574,30 @@ then the \".\"s will be lined up: :safe 'booleanp :group 'js) +(defcustom js-jsx-detect-syntax t + "When non-nil, automatically detect whether JavaScript uses JSX. +`js-jsx-syntax' (which see) may be made buffer-local and set to +t. The detection strategy can be customized by adding elements +to `js-jsx-regexps', which see." + :version "27.1" + :type 'boolean + :safe 'booleanp + :group 'js) + (defcustom js-jsx-syntax nil "When non-nil, parse JavaScript with consideration for JSX syntax. -This fixes indentation of JSX code in some cases. It is set to -be buffer-local when in `js-jsx-mode'." + +This enables proper font-locking and indentation of code using +Facebook’s “JSX” syntax extension for JavaScript, for use with +Facebook’s “React” library. Font-locking is like sgml-mode. +Indentation is also like sgml-mode, although some indentation +behavior may differ slightly to align more closely with the +conventions of the React developer community. + +When `js-mode' is already enabled, you should call +`js-jsx-enable' to set this variable. + +It is set to be buffer-local (and t) when in `js-jsx-mode'." :version "27.1" :type 'boolean :safe 'booleanp @@ -4223,6 +4243,79 @@ If one hasn't been set, or if it's stale, prompt for a new one." (when temp-name (delete-file temp-name)))))) +;;; Syntax extensions + +(defvar js-syntactic-mode-name t + "If non-nil, print enabled syntaxes in the mode name.") + +(defun js--update-mode-name () + "Print enabled syntaxes if `js-syntactic-mode-name' is t." + (when js-syntactic-mode-name + (setq mode-name (concat "JavaScript" + (if js-jsx-syntax "+JSX" ""))))) + +(defun js--idly-update-mode-name () + "Update `mode-name' whenever Emacs goes idle. +In case `js-jsx-syntax' is updated, especially by features of +Emacs like .dir-locals.el or file variables, this ensures the +modeline eventually reflects which syntaxes are enabled." + (let (timer) + (setq timer + (run-with-idle-timer + 0 t + (lambda (buffer) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (js--update-mode-name)) + (cancel-timer timer))) + (current-buffer))))) + +(defun js-jsx-enable () + "Enable JSX in the current buffer." + (interactive) + (setq-local js-jsx-syntax t) + (js--update-mode-name)) + +(defvar js-jsx-regexps + (list "\\_<\\(?:var\\|let\\|const\\|import\\)\\_>.*?React") + "Regexps for detecting JSX in JavaScript buffers. +When `js-jsx-detect-syntax' is non-nil and any of these regexps +match text near the beginning of a JavaScript buffer, +`js-jsx-syntax' (which see) will be made buffer-local and set to +t.") + +(defun js-jsx--detect-and-enable (&optional arbitrarily) + "Detect if JSX is likely to be used, and enable it if so. +Might make `js-jsx-syntax' buffer-local and set it to t. Matches +from the beginning of the buffer, unless optional arg ARBITRARILY +is non-nil. Return t after enabling, nil otherwise." + (when (or (and (buffer-file-name) + (string-match-p "\\.jsx\\'" (buffer-file-name))) + (and js-jsx-detect-syntax + (save-excursion + (unless arbitrarily + (goto-char (point-min))) + (catch 'match + (mapc + (lambda (regexp) + (if (re-search-forward regexp 4000 t) (throw 'match t))) + js-jsx-regexps) + nil)))) + (js-jsx-enable) + t)) + +(defun js-jsx--detect-after-change (beg end _len) + "Detect if JSX is likely to be used after a change. +This function is intended for use in `after-change-functions'." + (when (<= end 4000) + (save-excursion + (goto-char beg) + (beginning-of-line) + (save-restriction + (narrow-to-region (point) end) + (when (js-jsx--detect-and-enable 'arbitrarily) + (remove-hook 'after-change-functions #'js-jsx--detect-after-change t)))))) + ;;; Main Function ;;;###autoload @@ -4259,6 +4352,12 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;; Frameworks (js--update-quick-match-re) + ;; Syntax extensions + (unless (js-jsx--detect-and-enable) + (add-hook 'after-change-functions #'js-jsx--detect-after-change nil t)) + (js--update-mode-name) ; If `js-jsx-syntax' was set from outside. + (js--idly-update-mode-name) + ;; Imenu (setq imenu-case-fold-search nil) (setq imenu-create-index-function #'js--imenu-create-index) @@ -4304,10 +4403,20 @@ If one hasn't been set, or if it's stale, prompt for a new one." ) ;;;###autoload -(define-derived-mode js-jsx-mode js-mode "JSX" - "Major mode for editing JSX." +(define-derived-mode js-jsx-mode js-mode "JavaScript+JSX" + "Major mode for editing JavaScript+JSX. + +Simply makes `js-jsx-syntax' buffer-local and sets it to t. + +`js-mode' may detect and enable support for JSX automatically if +it appears to be used in a JavaScript file. You could also +customize `js-jsx-regexps' to improve that detection; or, you +could set `js-jsx-syntax' to t in your init file, or in a +.dir-locals.el file, or using file variables; or, you could call +`js-jsx-enable' in `js-mode-hook'. You may be better served by +one of the aforementioned options instead of using this mode." :group 'js - (setq-local js-jsx-syntax t)) + (js-jsx-enable)) ;;;###autoload (defalias 'javascript-mode 'js-mode) From 8b92719b6b31d26299b5feae0ea92bb80f835e3d Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 24 Mar 2019 09:55:14 -0700 Subject: [PATCH 073/121] Improve JSX syntax propertization MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx--attribute-name-re): New variable. (js-jsx--syntax-propertize-tag): Allow “-” in JSXAttribute names. Fix “out of range” error when typing at the end of a buffer. Fix/improve future propertization of unfinished JSXBoundaryElements. * test/manual/indent/js-jsx-unclosed-2.js: Add tests for allowed characters in JSX. --- lisp/progmodes/js.el | 74 ++++++++++++++----------- test/manual/indent/js-jsx-unclosed-2.js | 8 +++ 2 files changed, 51 insertions(+), 31 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 0bba8159c18..5d87489b524 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2083,11 +2083,15 @@ been propertized." (throw 'stop nil))) (setq text-beg (point)))))) +(defconst js-jsx--attribute-name-re (concat js--name-start-re + "\\(?:\\s_\\|\\sw\\|-\\)*") + "Like `js--name-re', but matches “-” as well.") + (defun js-jsx--syntax-propertize-tag (end) "Determine if a JSXBoundaryElement is before END and propertize it. Disambiguate JSX from inequality operators and arrow functions by testing for syntax only valid as JSX." - (let ((tag-beg (1- (point))) (type 'open) + (let ((tag-beg (1- (point))) tag-end (type 'open) name-beg name-match-data unambiguous forward-sexp-function) ; Use Lisp version. (catch 'stop @@ -2127,46 +2131,54 @@ testing for syntax only valid as JSX." ;; figure out what type it actually is. (if (eq type 'open) (setq type (if name-beg 'self-closing 'close))) (forward-char)) - ((looking-at js--dotted-name-re) - (if (not name-beg) - (progn - ;; Don’t match code like “if (i < await foo)” - (if (js--unary-keyword-p (match-string 0)) (throw 'stop nil)) - ;; Save boundaries for later fontification after - ;; unambiguously determining the code is JSX. - (setq name-beg (match-beginning 0) - name-match-data (match-data)) - (goto-char (match-end 0))) - (setq unambiguous t) ; Non-unary name followed by 2nd name ⇒ JSX - ;; Save JSXAttribute’s name’s match data for font-locking later. - (put-text-property (match-beginning 0) (1+ (match-beginning 0)) - 'js-jsx-attribute-name (match-data)) - (goto-char (match-end 0)) + ((and (not name-beg) (looking-at js--dotted-name-re)) + ;; Don’t match code like “if (i < await foo)” + (if (js--unary-keyword-p (match-string 0)) (throw 'stop nil)) + ;; Save boundaries for later fontification after + ;; unambiguously determining the code is JSX. + (setq name-beg (match-beginning 0) + name-match-data (match-data)) + (goto-char (match-end 0))) + ((and name-beg (looking-at js-jsx--attribute-name-re)) + (setq unambiguous t) ; Non-unary name followed by 2nd name ⇒ JSX + ;; Save JSXAttribute’s name’s match data for font-locking later. + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) + 'js-jsx-attribute-name (match-data)) + (goto-char (match-end 0)) + (if (>= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + ;; “=” is optional for null-valued JSXAttributes. + (when (= (char-after) ?=) + (forward-char) (if (>= (point) end) (throw 'stop nil)) (skip-chars-forward " \t\n" end) (if (>= (point) end) (throw 'stop nil)) - ;; “=” is optional for null-valued JSXAttributes. - (when (= (char-after) ?=) - (forward-char) - (if (>= (point) end) (throw 'stop nil)) - (skip-chars-forward " \t\n" end) - (if (>= (point) end) (throw 'stop nil)) - ;; Skip over strings (if possible). Any - ;; JSXExpressionContainer here will be parsed in the - ;; next iteration of the loop. - (when (memq (char-after) '(?\" ?\' ?\`)) - (condition-case nil - (forward-sexp) - (scan-error (throw 'stop nil))))))) + ;; Skip over strings (if possible). Any + ;; JSXExpressionContainer here will be parsed in the + ;; next iteration of the loop. + (when (memq (char-after) '(?\" ?\' ?\`)) + (condition-case nil + (forward-sexp) + (scan-error (throw 'stop nil)))))) ;; There is nothing more to check; this either isn’t JSX, or ;; the tag is incomplete. (t (throw 'stop nil))))) (when unambiguous ;; Save JSXBoundaryElement’s name’s match data for font-locking. (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) + ;; Prevent “out of range” errors when typing at the end of a buffer. + (setq tag-end (if (eobp) (1- (point)) (point))) ;; Mark beginning and end of tag for font-locking. - (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg (cons type (point))) - (put-text-property (point) (1+ (point)) 'js-jsx-tag-end tag-beg)) + (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg (cons type tag-end)) + (put-text-property tag-end (1+ tag-end) 'js-jsx-tag-end tag-beg) + ;; Use text properties to extend the syntax-propertize region + ;; backward to the beginning of the JSXBoundaryElement in the + ;; future. Typically the closing angle bracket could suggest + ;; extending backward, but that would also involve more rigorous + ;; parsing, and the closing angle bracket may not even exist yet + ;; if the JSXBoundaryElement is still being typed. + (put-text-property tag-beg (1+ tag-end) 'syntax-multiline t)) (if (js-jsx--at-enclosing-tag-child-p) (js-jsx--syntax-propertize-tag-text end)))) (defconst js-jsx--text-properties diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/js-jsx-unclosed-2.js index 8b6f33325d7..843ef9b6a88 100644 --- a/test/manual/indent/js-jsx-unclosed-2.js +++ b/test/manual/indent/js-jsx-unclosed-2.js @@ -29,3 +29,11 @@ while (await foo > bar) void 0 + +// “-” is not allowed in a JSXBoundaryElement’s name. + + // Weirdly-indented “continued expression.” + +// “-” may be used in a JSXAttribute’s name. + From d9d1bb2b07750f3b2f2a9f8fa3d7aa1a5ec5038e Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 24 Mar 2019 10:05:28 -0700 Subject: [PATCH 074/121] =?UTF-8?q?Rename=20tests=20to=20use=20the=20?= =?UTF-8?q?=E2=80=9C.jsx=E2=80=9D=20file=20extension?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * test/manual/indent/js-jsx-quote.js: Renamed to “jsx-quote.jsx”. * test/manual/indent/js-jsx-unclosed-1.js: Renamed to “jsx-unclosed-1.jsx”. * test/manual/indent/js-jsx-unclosed-2.js: Renamed to “jsx-unclosed-2.jsx”. * test/manual/indent/js-jsx.js: Renamed to “jsx.jsx”. * test/manual/indent/jsx-quote.jsx: Renamed from “js-jsx-quote.js”. * test/manual/indent/jsx-unclosed-1.jsx: Renamed from “js-jsx-unclosed-1.js”. * test/manual/indent/jsx-unclosed-2.jsx: Renamed from “js-jsx-unclosed-2.js”. * test/manual/indent/jsx.jsx: Renamed from “js-jsx.js”. --- test/manual/indent/{js-jsx-quote.js => jsx-quote.jsx} | 2 -- test/manual/indent/{js-jsx-unclosed-1.js => jsx-unclosed-1.jsx} | 2 -- test/manual/indent/{js-jsx-unclosed-2.js => jsx-unclosed-2.jsx} | 2 -- test/manual/indent/{js-jsx.js => jsx.jsx} | 2 -- 4 files changed, 8 deletions(-) rename test/manual/indent/{js-jsx-quote.js => jsx-quote.jsx} (95%) rename test/manual/indent/{js-jsx-unclosed-1.js => jsx-unclosed-1.jsx} (91%) rename test/manual/indent/{js-jsx-unclosed-2.js => jsx-unclosed-2.jsx} (97%) rename test/manual/indent/{js-jsx.js => jsx.jsx} (99%) diff --git a/test/manual/indent/js-jsx-quote.js b/test/manual/indent/jsx-quote.jsx similarity index 95% rename from test/manual/indent/js-jsx-quote.js rename to test/manual/indent/jsx-quote.jsx index 4b71a656744..1b2c6528734 100644 --- a/test/manual/indent/js-jsx-quote.js +++ b/test/manual/indent/jsx-quote.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - // JSX text node values should be strings, but only JS string syntax // is considered, so quote marks delimit strings like normal, with // disastrous results (https://github.com/mooz/js2-mode/issues/409). diff --git a/test/manual/indent/js-jsx-unclosed-1.js b/test/manual/indent/jsx-unclosed-1.jsx similarity index 91% rename from test/manual/indent/js-jsx-unclosed-1.js rename to test/manual/indent/jsx-unclosed-1.jsx index 9418aed7a12..1f5c3fba8da 100644 --- a/test/manual/indent/js-jsx-unclosed-1.js +++ b/test/manual/indent/jsx-unclosed-1.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/jsx-unclosed-2.jsx similarity index 97% rename from test/manual/indent/js-jsx-unclosed-2.js rename to test/manual/indent/jsx-unclosed-2.jsx index 843ef9b6a88..8db25aa67f1 100644 --- a/test/manual/indent/js-jsx-unclosed-2.js +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/jsx.jsx similarity index 99% rename from test/manual/indent/js-jsx.js rename to test/manual/indent/jsx.jsx index 2ec00c63bbd..c2351a8cf1d 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/jsx.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - var foo =
; return ( From 84b1cfbc2d6b9236913a18ed192798fd530911db Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 24 Mar 2019 13:17:12 -0700 Subject: [PATCH 075/121] Indent broken arrow function bodies as an N+1th arg MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js--line-terminating-arrow-re): Revise regexp for use with re-search-backward. (js--looking-at-broken-arrow-function-p): Remove. (js--broken-arrow-terminates-line-p): Replacement for js--looking-at-broken-arrow-function-p. Don’t consider whether an arrow appears at point (in an arglist); instead, just look for an arrow that terminates the line. (js--proper-indentation): Use js--broken-arrow-terminates-line-p. * test/manual/indent/js.js: Add test for a broken arrow as an N+1th arg. --- lisp/progmodes/js.el | 22 ++++++++-------------- test/manual/indent/js.js | 5 +++++ 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5d87489b524..f8dd72c22bc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2550,23 +2550,17 @@ indentation is aligned to that column." (when comma-p (goto-char (1+ declaration-keyword-end)))))))) -(defconst js--line-terminating-arrow-re "\\s-*=>\\s-*\\(/[/*]\\|$\\)" +(defconst js--line-terminating-arrow-re "=>\\s-*\\(/[/*]\\|$\\)" "Regexp matching the last \"=>\" (arrow) token on a line. Whitespace and comments around the arrow are ignored.") -(defun js--looking-at-broken-arrow-function-p () +(defun js--broken-arrow-terminates-line-p () "Helper function for `js--proper-indentation'. -Return t if point is at the start of a (possibly async) arrow -function and the last non-comment, non-whitespace token of the -current line is the \"=>\" token." - (when (looking-at "\\s-*async\\s-*") - (goto-char (match-end 0))) - (cond - ((eq (char-after) ?\() - (forward-list) - (looking-at-p js--line-terminating-arrow-re)) - (t (looking-at-p - (concat js--name-re js--line-terminating-arrow-re))))) +Return t if the last non-comment, non-whitespace token of the +current line is the \"=>\" token (of an arrow function)." + (let ((from (point))) + (end-of-line) + (re-search-backward js--line-terminating-arrow-re from t))) (defun js-jsx--context () "Determine JSX context and move to enclosing JSX." @@ -2713,7 +2707,7 @@ return nil." (goto-char (nth 1 parse-status)) ; go to the opening char (if (or (not js-indent-align-list-continuation) (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)") - (save-excursion (forward-char) (js--looking-at-broken-arrow-function-p))) + (save-excursion (forward-char) (js--broken-arrow-terminates-line-p))) (progn ; nothing following the opening paren/bracket (skip-syntax-backward " ") (when (eq (char-before) ?\)) (backward-list)) diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js index 647d7438f45..9658c95701c 100644 --- a/test/manual/indent/js.js +++ b/test/manual/indent/js.js @@ -160,6 +160,11 @@ foo.bar.baz(very => // A comment snorf ); +// Continuation of bug#25904; support broken arrow as N+1th arg +map(arr, (val) => + val +) + // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 From 16669d7c5d5a0dfadf672f8359e431ef81044a23 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Mon, 25 Mar 2019 20:39:48 -0700 Subject: [PATCH 076/121] Fix counting of nested self-closing JSXOpeningElements * lisp/progmodes/js.el (js-jsx--matching-close-tag-pos): Fix bug where self-closing JSXOpeningElements might be missed if one was nested within another. * test/manual/indent/jsx-self-closing.jsx: Add test for bug concerning self-closing JSXOpeningElement counting. --- lisp/progmodes/js.el | 39 +++++++++---------------- test/manual/indent/jsx-self-closing.jsx | 13 +++++++++ 2 files changed, 27 insertions(+), 25 deletions(-) create mode 100644 test/manual/indent/jsx-self-closing.jsx diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f8dd72c22bc..f22c68cff95 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1934,40 +1934,29 @@ Assuming a JSXOpeningElement or a JSXOpeningFragment is immediately before point, find a matching JSXClosingElement or JSXClosingFragment, skipping over any nested JSXElements to find the match. Return nil if a match can’t be found." - (let ((tag-stack 1) self-closing-pos type) + (let ((tag-stack 1) type tag-pos last-pos pos) (catch 'stop (while (re-search-forward js-jsx--tag-re nil t) - (setq type (js-jsx--matched-tag-type)) - ;; Balance the total of self-closing tags that we subtract - ;; from the stack, ignoring those tags which are never added - ;; to the stack (see below). - (unless (eq type 'self-closing) - (when (and self-closing-pos (> (point) self-closing-pos)) + (setq type (js-jsx--matched-tag-type) + tag-pos (match-beginning 0)) + ;; Clear the stack of any JSXOpeningElements which turned out + ;; to be self-closing. + (when last-pos + (setq pos (point)) + (goto-char last-pos) + (while (re-search-forward js-jsx--self-closing-re pos 'move) (setq tag-stack (1- tag-stack)))) (if (eq type 'close) (progn (setq tag-stack (1- tag-stack)) (when (= tag-stack 0) - (throw 'stop (match-beginning 0)))) - ;; Tags that we know are self-closing aren’t added to the - ;; stack at all, because we only close the ones that we have - ;; anticipated after moving past those anticipated tags’ - ;; ends, and if a self-closing tag is the first tag we - ;; encounter in this loop, then it will never be anticipated - ;; (due to an optimization where we sometimes can avoid - ;; looking for self-closing tags). + (throw 'stop tag-pos))) + ;; JSXOpeningElements that we know are self-closing aren’t + ;; added to the stack at all (since re-search-forward moves + ;; point after their self-closing syntax). (unless (eq type 'self-closing) (setq tag-stack (1+ tag-stack)))) - ;; Don’t needlessly recalculate. - (unless (and self-closing-pos (<= (point) self-closing-pos)) - (setq self-closing-pos nil) ; Reset if recalculating. - (save-excursion - ;; Anticipate a self-closing tag that we should make sure - ;; to subtract from the tag stack once we move past its - ;; end; we might might miss the end otherwise, due to the - ;; regexp-matching method we use to detect tags. - (when (re-search-forward js-jsx--self-closing-re nil t) - (setq self-closing-pos (match-beginning 0))))))))) + (setq last-pos (point)))))) (defun js-jsx--enclosing-curly-pos () "Return position of enclosing “{” in a “{/}” pair about point." diff --git a/test/manual/indent/jsx-self-closing.jsx b/test/manual/indent/jsx-self-closing.jsx new file mode 100644 index 00000000000..f8ea7a138ad --- /dev/null +++ b/test/manual/indent/jsx-self-closing.jsx @@ -0,0 +1,13 @@ +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following test goes below any comments to avoid including +// misindented comments among the erroring lines. + +// Properly parse/indent code with a self-closing tag inside the +// attribute of another self-closing tag. +
+
} /> +
From 55c80d43a972d3e126c173745c57a0a383bd3ad4 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 26 Mar 2019 18:18:39 -0700 Subject: [PATCH 077/121] =?UTF-8?q?Indent=20expressions=20in=20JSXAttribut?= =?UTF-8?q?es=20relative=20to=20the=20attribute=E2=80=99s=20name?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx--syntax-propertize-tag): Refer to the beginning of a JSXExpressionContainer’s associated JSXAttribute (so line numbers can be calculated later). (js-jsx--text-properties): Also clear the new text property js-jsx-expr-attribute. (js-jsx--indenting): Remove. (js-jsx--indent-col, js-jsx--indent-attribute-line): New variables. (js-jsx--indentation): Instead of alternating between two separate column calculations, neither necessarily correct, bind the JSX column such that the second call to js--proper-indentation can use it as a base column. (js--proper-indentation): Use JSX as the base column for some indents while indenting JSX. * test/manual/indent/jsx.jsx: Add more tests for expression indents. --- lisp/progmodes/js.el | 97 +++++++++++++++++++++++--------------- test/manual/indent/jsx.jsx | 25 ++++++++++ 2 files changed, 83 insertions(+), 39 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f22c68cff95..679633fc836 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2081,7 +2081,7 @@ been propertized." Disambiguate JSX from inequality operators and arrow functions by testing for syntax only valid as JSX." (let ((tag-beg (1- (point))) tag-end (type 'open) - name-beg name-match-data unambiguous + name-beg name-match-data expr-attribute-beg unambiguous forward-sexp-function) ; Use Lisp version. (catch 'stop (while (and (< (point) end) @@ -2096,8 +2096,16 @@ testing for syntax only valid as JSX." ;; JSXExpressionContainer as a JSXAttribute value ;; (“\" token (of an arrow function)." (list 'tag (nth 0 enclosing-tag-pos) (nth 1 enclosing-tag-pos))) (list 'text (nth 0 enclosing-tag-pos) (nth 2 enclosing-tag-pos)))))) -(defvar js-jsx--indenting nil - "Flag to prevent infinite recursion while indenting JSX.") +(defvar js-jsx--indent-col nil + "Baseline column for JS indentation within JSX.") + +(defvar js-jsx--indent-attribute-line nil + "Line relative to which indentation uses JSX as a baseline.") (defun js-jsx--indentation (parse-status) "Helper function for `js--proper-indentation'. @@ -2642,25 +2657,22 @@ return nil." 0))) ))) - ;; When indenting a JSXExpressionContainer expression, use JSX - ;; indentation as a minimum, and use regular JS indentation if - ;; it’s deeper. + ;; To indent a JSXExpressionContainer’s expression, calculate + ;; the JS indentation, possibly using JSX indentation as the + ;; base column. (if expr-p - (max (+ col - ;; An expression in a JSXExpressionContainer in a - ;; JSXAttribute should be indented more, except on - ;; the ending line of the JSXExpressionContainer. - (if (and (eq (nth 0 context) 'tag) - (< current-line - (save-excursion - (js-jsx--goto-outermost-enclosing-curly - (nth 1 context)) - (forward-sexp) - (line-number-at-pos)))) - js-indent-level - 0)) - (let ((js-jsx--indenting t)) ; Prevent recursion. - (js--proper-indentation parse-status))) + (let* ((js-jsx--indent-col col) + (expr-attribute-pos + (save-excursion + (goto-char curly-pos) ; Skip first curly. + ;; Skip any remaining enclosing curlies up until + ;; the contextual JSXElement’s beginning position. + (js-jsx--goto-outermost-enclosing-curly (nth 1 context)) + (get-text-property (point) 'js-jsx-expr-attribute))) + (js-jsx--indent-attribute-line + (when expr-attribute-pos + (line-number-at-pos expr-attribute-pos)))) + (js--proper-indentation parse-status)) col)))) (defun js--proper-indentation (parse-status) @@ -2670,7 +2682,7 @@ return nil." (cond ((nth 4 parse-status) ; inside comment (js--get-c-offset 'c (nth 8 parse-status))) ((nth 3 parse-status) 0) ; inside string - ((when (and js-jsx-syntax (not js-jsx--indenting)) + ((when (and js-jsx-syntax (not js-jsx--indent-col)) (save-excursion (js-jsx--indentation parse-status)))) ((eq (char-after) ?#) 0) ((save-excursion (js--beginning-of-macro)) 4) @@ -2708,17 +2720,24 @@ return nil." (and switch-keyword-p in-switch-p))) (indent - (cond (same-indent-p - (current-column)) - (continued-expr-p - (+ (current-column) (* 2 js-indent-level) - js-expr-indent-offset)) - (t - (+ (current-column) js-indent-level - (pcase (char-after (nth 1 parse-status)) - (?\( js-paren-indent-offset) - (?\[ js-square-indent-offset) - (?\{ js-curly-indent-offset))))))) + (+ + (cond + ((and js-jsx--indent-attribute-line + (eq js-jsx--indent-attribute-line + (line-number-at-pos))) + js-jsx--indent-col) + (t + (current-column))) + (cond (same-indent-p 0) + (continued-expr-p + (+ (* 2 js-indent-level) + js-expr-indent-offset)) + (t + (+ js-indent-level + (pcase (char-after (nth 1 parse-status)) + (?\( js-paren-indent-offset) + (?\[ js-square-indent-offset) + (?\{ js-curly-indent-offset)))))))) (if in-switch-p (+ indent js-switch-indent-offset) indent))) diff --git a/test/manual/indent/jsx.jsx b/test/manual/indent/jsx.jsx index c2351a8cf1d..5004d57a0b1 100644 --- a/test/manual/indent/jsx.jsx +++ b/test/manual/indent/jsx.jsx @@ -68,6 +68,31 @@ return (
); +return ( +
// Also dedent. +); + +return ( +
+) + // Indent void expressions (no need for contextual parens / commas) // (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016).
From afec4511cf5c336eaf9f8bb1425bf2dd1fc12740 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 26 Mar 2019 20:14:46 -0700 Subject: [PATCH 078/121] Split JSX indentation calculation into several functions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx--contextual-indentation) (js-jsx--expr-attribute-pos, js-jsx--expr-indentation): Extract logic from js-jsx--indentation, and improve the logic’s documentation. (js-jsx--indentation): Simplify by splitting into several functions (see above) and improve the logic’s documentation. --- lisp/progmodes/js.el | 146 ++++++++++++++++++++++++------------------- 1 file changed, 81 insertions(+), 65 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 679633fc836..2d29d4e443a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2575,12 +2575,86 @@ current line is the \"=>\" token (of an arrow function)." (list 'tag (nth 0 enclosing-tag-pos) (nth 1 enclosing-tag-pos))) (list 'text (nth 0 enclosing-tag-pos) (nth 2 enclosing-tag-pos)))))) +(defun js-jsx--contextual-indentation (line context) + "Calculate indentation column for LINE from CONTEXT. +The column calculation is based off of `sgml-calculate-indent'." + (pcase (nth 0 context) + + ('string + ;; Go back to previous non-empty line. + (while (and (> (point) (nth 1 context)) + (zerop (forward-line -1)) + (looking-at "[ \t]*$"))) + (if (> (point) (nth 1 context)) + ;; Previous line is inside the string. + (current-indentation) + (goto-char (nth 1 context)) + (1+ (current-column)))) + + ('tag + ;; Special JSX indentation rule: a “dangling” closing angle + ;; bracket on its own line is indented at the same level as the + ;; opening angle bracket of the JSXElement. Otherwise, indent + ;; JSXAttribute space like SGML. + (if (progn + (goto-char (nth 2 context)) + (and (= line (line-number-at-pos)) + (looking-back "^\\s-*/?>" (line-beginning-position)))) + (progn + (goto-char (nth 1 context)) + (current-column)) + ;; Indent JSXAttribute space like SGML. + (goto-char (nth 1 context)) + ;; Skip tag name: + (skip-chars-forward " \t") + (skip-chars-forward "^ \t\n") + (skip-chars-forward " \t") + (if (not (eolp)) + (current-column) + ;; This is the first attribute: indent. + (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) + (+ (current-column) js-indent-level)))) + + ('text + ;; Indent to reflect nesting. + (goto-char (nth 1 context)) + (+ (current-column) + ;; The last line isn’t nested, but the rest are. + (if (or (not (nth 2 context)) ; Unclosed. + (< line (line-number-at-pos (nth 2 context)))) + js-indent-level + 0))) + + )) + +(defun js-jsx--expr-attribute-pos (start limit) + "Look back from START to LIMIT for a JSXAttribute." + (save-excursion + (goto-char start) ; Skip the first curly. + ;; Skip any remaining enclosing curlies until the JSXElement’s + ;; beginning position; the last curly ought to be one of a + ;; JSXExpressionContainer, which may refer to its JSXAttribute’s + ;; beginning position (if it has one). + (js-jsx--goto-outermost-enclosing-curly limit) + (get-text-property (point) 'js-jsx-expr-attribute))) + (defvar js-jsx--indent-col nil "Baseline column for JS indentation within JSX.") (defvar js-jsx--indent-attribute-line nil "Line relative to which indentation uses JSX as a baseline.") +(defun js-jsx--expr-indentation (parse-status pos col) + "Indent using PARSE-STATUS; relative to POS, use base COL. +To indent a JSXExpressionContainer’s expression, calculate the JS +indentation, using JSX indentation as the base column when +indenting relative to the beginning line of the +JSXExpressionContainer’s JSXAttribute (if any)." + (let* ((js-jsx--indent-col col) + (js-jsx--indent-attribute-line + (if pos (line-number-at-pos pos)))) + (js--proper-indentation parse-status))) + (defun js-jsx--indentation (parse-status) "Helper function for `js--proper-indentation'. Return the proper indentation of the current line if it is part @@ -2605,74 +2679,16 @@ return nil." (and (= beg-line current-line) (or (not curly-pos) (> (point) curly-pos))))))) + ;; When on the second or later line of JSX, indent as JSX, + ;; possibly switching back to JS indentation within + ;; JSXExpressionContainers, possibly using the JSX as a base + ;; column while switching back to JS indentation. (when (and context (> current-line beg-line)) (save-excursion - ;; The column calculation is based on `sgml-calculate-indent'. - (setq col (pcase (nth 0 context) - - ('string - ;; Go back to previous non-empty line. - (while (and (> (point) (nth 1 context)) - (zerop (forward-line -1)) - (looking-at "[ \t]*$"))) - (if (> (point) (nth 1 context)) - ;; Previous line is inside the string. - (current-indentation) - (goto-char (nth 1 context)) - (1+ (current-column)))) - - ('tag - ;; Special JSX indentation rule: a “dangling” - ;; closing angle bracket on its own line is - ;; indented at the same level as the opening - ;; angle bracket of the JSXElement. Otherwise, - ;; indent JSXAttribute space like SGML. - (if (progn - (goto-char (nth 2 context)) - (and (= current-line (line-number-at-pos)) - (looking-back "^\\s-*/?>" (line-beginning-position)))) - (progn - (goto-char (nth 1 context)) - (current-column)) - ;; Indent JSXAttribute space like SGML. - (goto-char (nth 1 context)) - ;; Skip tag name: - (skip-chars-forward " \t") - (skip-chars-forward "^ \t\n") - (skip-chars-forward " \t") - (if (not (eolp)) - (current-column) - ;; This is the first attribute: indent. - (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) - (+ (current-column) js-indent-level)))) - - ('text - ;; Indent to reflect nesting. - (goto-char (nth 1 context)) - (+ (current-column) - ;; The last line isn’t nested, but the rest are. - (if (or (not (nth 2 context)) ; Unclosed. - (< current-line (line-number-at-pos (nth 2 context)))) - js-indent-level - 0))) - - ))) - ;; To indent a JSXExpressionContainer’s expression, calculate - ;; the JS indentation, possibly using JSX indentation as the - ;; base column. + (setq col (js-jsx--contextual-indentation current-line context))) (if expr-p - (let* ((js-jsx--indent-col col) - (expr-attribute-pos - (save-excursion - (goto-char curly-pos) ; Skip first curly. - ;; Skip any remaining enclosing curlies up until - ;; the contextual JSXElement’s beginning position. - (js-jsx--goto-outermost-enclosing-curly (nth 1 context)) - (get-text-property (point) 'js-jsx-expr-attribute))) - (js-jsx--indent-attribute-line - (when expr-attribute-pos - (line-number-at-pos expr-attribute-pos)))) - (js--proper-indentation parse-status)) + (js-jsx--expr-indentation + parse-status (js-jsx--expr-attribute-pos curly-pos (nth 1 context)) col) col)))) (defun js--proper-indentation (parse-status) From 462baabed93228a00e5ccadbe5704fb317957cb7 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 26 Mar 2019 21:47:34 -0700 Subject: [PATCH 079/121] Add tests for miscellaneous JSX parsing feats * test/manual/indent/jsx.jsx: Add tests for JSXMemberExpression names and JSXOpeningFragment/JSXClosingFragment support (already supported). --- test/manual/indent/jsx.jsx | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/test/manual/indent/jsx.jsx b/test/manual/indent/jsx.jsx index 5004d57a0b1..c200979df8c 100644 --- a/test/manual/indent/jsx.jsx +++ b/test/manual/indent/jsx.jsx @@ -93,6 +93,32 @@ return ( } /> ) +// JSXMemberExpression names are parsed/indented: + +
+ + Hello World! + + +
+
+ +
+ + +// JSXOpeningFragment and JSXClosingFragment are parsed/indented: +<> +
+ <> + Hello World! + + <> +
+
+ +
+ + // Indent void expressions (no need for contextual parens / commas) // (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016).
From 7b2e3c60d081597adb7feaaabfee8cb8de62289b Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 7 Apr 2019 00:25:35 -0700 Subject: [PATCH 080/121] Optimize js-jsx--matching-close-tag-pos MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This function’s performance was having a noticeable impact when editing large JSX structures. Improve its performance slightly (elapsed time will be cut in half according to ELP). * lisp/progmodes/js.el (js-jsx--tag-re): Remove. (js-jsx--matched-tag-type): Simplify implementation with respect to the new implementation of js-jsx--matching-close-tag-pos. (js-jsx--self-closing-re): Simplify regexp slightly in sync with a generally simpler matching algorithm. (js-jsx--matching-close-tag-pos): Optimize matching algorithm by using multiple simple regexp searches, rather than one big complex search. * test/manual/indent/jsx-unclosed-2.jsx: Use the term “inequality” and add a test for a possible parsing foible. --- lisp/progmodes/js.el | 67 +++++++++++++-------------- test/manual/indent/jsx-unclosed-2.jsx | 7 ++- 2 files changed, 37 insertions(+), 37 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 2d29d4e443a..694a79f0d97 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1906,26 +1906,23 @@ For use by `syntax-propertize-extend-region-functions'." (throw 'stop nil))))))) (if new-start (cons new-start end)))) -(defconst js-jsx--tag-re - (concat "<\\s-*\\(" - "[/>]" ; JSXClosingElement, or JSXOpeningFragment, or JSXClosingFragment - "\\|" - js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]" ; JSXOpeningElement - "\\)") - "Regexp unambiguously matching a JSXBoundaryElement.") +(defconst js-jsx--tag-start-re + (concat js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]") + "Regexp unambiguously matching a JSXOpeningElement.") (defun js-jsx--matched-tag-type () - "Determine the tag type of the last match to `js-jsx--tag-re'. + "Determine if the last “<” was a JSXBoundaryElement and its type. Return `close' for a JSXClosingElement/JSXClosingFragment match, return `self-closing' for some self-closing JSXOpeningElements, else return `other'." - (let ((chars (vconcat (match-string 1)))) - (cond - ((= (aref chars 0) ?/) 'close) - ((= (aref chars (1- (length chars))) ?/) 'self-closing) - (t 'other)))) + (cond + ((= (char-after) ?/) (forward-char) 'close) ; JSXClosingElement/JSXClosingFragment + ((= (char-after) ?>) (forward-char) 'other) ; JSXOpeningFragment + ((looking-at js-jsx--tag-start-re) ; JSXOpeningElement + (goto-char (match-end 0)) + (if (= (char-before) ?/) 'self-closing 'other)))) -(defconst js-jsx--self-closing-re "/\\s-*>" +(defconst js-jsx--self-closing-re "/>" "Regexp matching the end of a self-closing JSXOpeningElement.") (defun js-jsx--matching-close-tag-pos () @@ -1934,29 +1931,27 @@ Assuming a JSXOpeningElement or a JSXOpeningFragment is immediately before point, find a matching JSXClosingElement or JSXClosingFragment, skipping over any nested JSXElements to find the match. Return nil if a match can’t be found." - (let ((tag-stack 1) type tag-pos last-pos pos) + (let ((tag-stack 1) tag-pos type last-pos pos) (catch 'stop - (while (re-search-forward js-jsx--tag-re nil t) - (setq type (js-jsx--matched-tag-type) - tag-pos (match-beginning 0)) - ;; Clear the stack of any JSXOpeningElements which turned out - ;; to be self-closing. - (when last-pos - (setq pos (point)) - (goto-char last-pos) - (while (re-search-forward js-jsx--self-closing-re pos 'move) - (setq tag-stack (1- tag-stack)))) - (if (eq type 'close) - (progn - (setq tag-stack (1- tag-stack)) - (when (= tag-stack 0) - (throw 'stop tag-pos))) - ;; JSXOpeningElements that we know are self-closing aren’t - ;; added to the stack at all (since re-search-forward moves - ;; point after their self-closing syntax). - (unless (eq type 'self-closing) - (setq tag-stack (1+ tag-stack)))) - (setq last-pos (point)))))) + (while (and (re-search-forward "<" nil t) (not (eobp))) + (when (setq tag-pos (match-beginning 0) + type (js-jsx--matched-tag-type)) + (when last-pos + (setq pos (point)) + (goto-char last-pos) + (while (re-search-forward js-jsx--self-closing-re pos 'move) + (setq tag-stack (1- tag-stack)))) + (if (eq type 'close) + (progn + (setq tag-stack (1- tag-stack)) + (when (= tag-stack 0) + (throw 'stop tag-pos))) + ;; JSXOpeningElements that we know are self-closing aren’t + ;; added to the stack at all (because point is already + ;; past that syntax). + (unless (eq type 'self-closing) + (setq tag-stack (1+ tag-stack)))) + (setq last-pos (point))))))) (defun js-jsx--enclosing-curly-pos () "Return position of enclosing “{” in a “{/}” pair about point." diff --git a/test/manual/indent/jsx-unclosed-2.jsx b/test/manual/indent/jsx-unclosed-2.jsx index 8db25aa67f1..9d80a2e9ae2 100644 --- a/test/manual/indent/jsx-unclosed-2.jsx +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -6,10 +6,15 @@ // The following tests go below any comments to avoid including // misindented comments among the erroring lines. -// Don’t misinterpret equality operators as JSX. +// Don’t misinterpret inequality operators as JSX. for (; i < length;) void 0 if (foo > bar) void 0 +// Don’t misintrepet inequalities within JSX, either. +
+ {foo < bar} +
+ // Don’t even misinterpret unary operators as JSX. if (foo < await bar) void 0 while (await foo > bar) void 0 From 98e36a3e31da10bf230743d285544305f730b60d Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 7 Apr 2019 13:25:57 -0700 Subject: [PATCH 081/121] Optimize js-jsx--enclosing-tag-pos MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx--enclosing-tag-pos): Update docstring to be more precise. Also, remember close tag positions after they’ve been calculated once to avoid many redundant calls to js-jsx--matching-close-tag-pos. (js-jsx--text-properties): Ensure js-jsx-close-tag-pos text properties get cleaned up, too. --- lisp/progmodes/js.el | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 694a79f0d97..21e6b683b78 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1976,7 +1976,7 @@ the match. Return nil if a match can’t be found." (defun js-jsx--enclosing-tag-pos () "Return beginning and end of a JSXElement about point. Look backward for a JSXElement that both starts before point and -also ends after point. That may be either a self-closing +also ends at/after point. That may be either a self-closing JSXElement or a JSXOpeningElement/JSXClosingElement pair." (let ((start (point)) tag-beg tag-beg-pos tag-end-pos close-tag-pos) (while @@ -1991,9 +1991,21 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." (< start tag-end-pos)) (and (eq (car tag-beg) 'open) (or (< start tag-end-pos) - (save-excursion - (goto-char tag-end-pos) - (setq close-tag-pos (js-jsx--matching-close-tag-pos)) + (progn + (unless + ;; Try to read a cached close position, + ;; but it might not be available yet. + (setq close-tag-pos + (get-text-property (point) 'js-jsx-close-tag-pos)) + (save-excursion + (goto-char tag-end-pos) + (setq close-tag-pos (js-jsx--matching-close-tag-pos))) + (when close-tag-pos + ;; Cache the close position to make future + ;; searches faster. + (put-text-property + (point) (1+ (point)) + 'js-jsx-close-tag-pos close-tag-pos))) ;; The JSXOpeningElement may be unclosed, else ;; the closure must occur at/after the start ;; point (otherwise, a miscellaneous previous @@ -2179,7 +2191,7 @@ testing for syntax only valid as JSX." (defconst js-jsx--text-properties (list - 'js-jsx-tag-beg nil 'js-jsx-tag-end nil + 'js-jsx-tag-beg nil 'js-jsx-tag-end nil 'js-jsx-close-tag-pos nil 'js-jsx-tag-name nil 'js-jsx-attribute-name nil 'js-jsx-text nil 'js-jsx-expr nil 'js-jsx-expr-attribute nil) "Plist of text properties added by `js-syntax-propertize'.") From 7a9dac5c944432cc2329473bb1dd9db9c0bfdd99 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 7 Apr 2019 14:36:47 -0700 Subject: [PATCH 082/121] Improve whitespace and unary keyword parsing MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js--name-start-chars): Remove, adding these chars back to js--name-start-re. (js--name-start-re): Add chars back from js--name-start-chars. (js-jsx--tag-start-re): Improve regexp to capture the tag name (so it can be disambiguated from a unary keyword), to match newlines (which are common in this spot), and to require at least one whitespace character before the attribute name. (js-jsx--matched-tag-type): Ensure the “tag name” isn’t possibly a unary keyword. (js-jsx--self-closing-re, js-jsx--matching-close-tag-pos): Allow whitespace around “<” and “>”. * test/manual/indent/jsx-unclosed-2.jsx: Add tests for unary keyword and whitespace parsing. --- lisp/progmodes/js.el | 19 +++++++++++-------- test/manual/indent/jsx-unclosed-2.jsx | 16 ++++++++++++++++ 2 files changed, 27 insertions(+), 8 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 21e6b683b78..e42c455c84c 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -65,10 +65,7 @@ ;;; Constants -(defconst js--name-start-chars "a-zA-Z_$" - "Character class chars matching the start of a JavaScript identifier.") - -(defconst js--name-start-re (concat "[" js--name-start-chars "]") +(defconst js--name-start-re (concat "[a-zA-Z_$]") "Regexp matching the start of a JavaScript identifier, without grouping.") (defconst js--stmt-delim-chars "^;{}?:") @@ -1907,7 +1904,12 @@ For use by `syntax-propertize-extend-region-functions'." (if new-start (cons new-start end)))) (defconst js-jsx--tag-start-re - (concat js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]") + (concat "\\(" js--dotted-name-re "\\)\\(?:" + ;; Whitespace is only necessary if an attribute implies JSX. + "\\(?:\\s-\\|\n\\)*[{/>]" + "\\|" + "\\(?:\\s-\\|\n\\)+" js--name-start-re + "\\)") "Regexp unambiguously matching a JSXOpeningElement.") (defun js-jsx--matched-tag-type () @@ -1918,11 +1920,12 @@ else return `other'." (cond ((= (char-after) ?/) (forward-char) 'close) ; JSXClosingElement/JSXClosingFragment ((= (char-after) ?>) (forward-char) 'other) ; JSXOpeningFragment - ((looking-at js-jsx--tag-start-re) ; JSXOpeningElement + ((and (looking-at js-jsx--tag-start-re) ; JSXOpeningElement + (not (js--unary-keyword-p (match-string 1)))) (goto-char (match-end 0)) (if (= (char-before) ?/) 'self-closing 'other)))) -(defconst js-jsx--self-closing-re "/>" +(defconst js-jsx--self-closing-re "/\\s-*>" "Regexp matching the end of a self-closing JSXOpeningElement.") (defun js-jsx--matching-close-tag-pos () @@ -1933,7 +1936,7 @@ JSXClosingFragment, skipping over any nested JSXElements to find the match. Return nil if a match can’t be found." (let ((tag-stack 1) tag-pos type last-pos pos) (catch 'stop - (while (and (re-search-forward "<" nil t) (not (eobp))) + (while (and (re-search-forward "<\\s-*" nil t) (not (eobp))) (when (setq tag-pos (match-beginning 0) type (js-jsx--matched-tag-type)) (when last-pos diff --git a/test/manual/indent/jsx-unclosed-2.jsx b/test/manual/indent/jsx-unclosed-2.jsx index 9d80a2e9ae2..be0a605503f 100644 --- a/test/manual/indent/jsx-unclosed-2.jsx +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -19,6 +19,10 @@ if (foo > bar) void 0 if (foo < await bar) void 0 while (await foo > bar) void 0 +
+ {foo < await bar} +
+ // Allow unary keyword names as null-valued JSX attributes. // (As if this will EVER happen…) @@ -40,3 +44,15 @@ while (await foo > bar) void 0 // “-” may be used in a JSXAttribute’s name. + +// Weird spaces should be tolerated. +< div > + < div > + < div + attr="" + / > + < div + attr="" + / > + < / div> +< / div > From e48306f84f1aeb4409cc02ae864f33e7af657288 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Sun, 7 Apr 2019 18:12:26 -0700 Subject: [PATCH 083/121] Properly set a dynamic, syntactic mode name MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Use mode-line-format constructs to properly set mode-name, rather than use the very hacky solution that was filling-in for my lack of knowledge of this feature. * lisp/progmodes/js.el (js--update-mode-name) (js--idly-update-mode-name): Remove. (js--syntactic-mode-name-part): New helper function for mode-name. (js-use-syntactic-mode-name): Helper to set up the dynamic mode-name. (js-jsx-enable): Don’t need to call any extra functions now. (js-mode): Use the new setup function rather than the old ones. (js-jsx-mode): Use the same initial mode name as js-mode so the final one is identical for both modes. --- lisp/progmodes/js.el | 46 +++++++++++++++++++------------------------- 1 file changed, 20 insertions(+), 26 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e42c455c84c..a1de3ef7959 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4288,33 +4288,27 @@ If one hasn't been set, or if it's stale, prompt for a new one." (defvar js-syntactic-mode-name t "If non-nil, print enabled syntaxes in the mode name.") -(defun js--update-mode-name () - "Print enabled syntaxes if `js-syntactic-mode-name' is t." - (when js-syntactic-mode-name - (setq mode-name (concat "JavaScript" - (if js-jsx-syntax "+JSX" ""))))) +(defun js--syntactic-mode-name-part () + "Return a string like “[JSX]” when `js-jsx-syntax' is enabled." + (if js-syntactic-mode-name + (let (syntaxes) + (if js-jsx-syntax (push "JSX" syntaxes)) + (if syntaxes + (concat "[" (mapconcat #'identity syntaxes ",") "]") + "")) + "")) -(defun js--idly-update-mode-name () - "Update `mode-name' whenever Emacs goes idle. -In case `js-jsx-syntax' is updated, especially by features of -Emacs like .dir-locals.el or file variables, this ensures the -modeline eventually reflects which syntaxes are enabled." - (let (timer) - (setq timer - (run-with-idle-timer - 0 t - (lambda (buffer) - (if (buffer-live-p buffer) - (with-current-buffer buffer - (js--update-mode-name)) - (cancel-timer timer))) - (current-buffer))))) +(defun js-use-syntactic-mode-name () + "Print enabled syntaxes if `js-syntactic-mode-name' is t. +Modes deriving from `js-mode' should call this to ensure that +their `mode-name' updates to show enabled syntax extensions." + (when (stringp mode-name) + (setq mode-name `(,mode-name (:eval (js--syntactic-mode-name-part)))))) (defun js-jsx-enable () "Enable JSX in the current buffer." (interactive) - (setq-local js-jsx-syntax t) - (js--update-mode-name)) + (setq-local js-jsx-syntax t)) (defvar js-jsx-regexps (list "\\_<\\(?:var\\|let\\|const\\|import\\)\\_>.*?React") @@ -4395,8 +4389,7 @@ This function is intended for use in `after-change-functions'." ;; Syntax extensions (unless (js-jsx--detect-and-enable) (add-hook 'after-change-functions #'js-jsx--detect-after-change nil t)) - (js--update-mode-name) ; If `js-jsx-syntax' was set from outside. - (js--idly-update-mode-name) + (js-use-syntactic-mode-name) ;; Imenu (setq imenu-case-fold-search nil) @@ -4443,7 +4436,7 @@ This function is intended for use in `after-change-functions'." ) ;;;###autoload -(define-derived-mode js-jsx-mode js-mode "JavaScript+JSX" +(define-derived-mode js-jsx-mode js-mode "JavaScript" "Major mode for editing JavaScript+JSX. Simply makes `js-jsx-syntax' buffer-local and sets it to t. @@ -4456,7 +4449,8 @@ could set `js-jsx-syntax' to t in your init file, or in a `js-jsx-enable' in `js-mode-hook'. You may be better served by one of the aforementioned options instead of using this mode." :group 'js - (js-jsx-enable)) + (js-jsx-enable) + (js-use-syntactic-mode-name)) ;;;###autoload (defalias 'javascript-mode 'js-mode) From 3eadf1eff43c84a1095094334549a1e0d1e75d80 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Mon, 8 Apr 2019 07:47:37 -0700 Subject: [PATCH 084/121] Identify JSX strings (for js2-mode) * lisp/progmodes/js.el (js-jsx--syntax-propertize-tag): Derived modes like js2-mode may use font-lock-syntactic-face-function to apply faces to JSX strings (and only JSX strings). Apply the js-jsx-string text property to such strings so they can be distinctly identified. (js-jsx--text-properties): Ensure the js-jsx-string text property gets cleaned up, too. --- lisp/progmodes/js.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index a1de3ef7959..b1068bfc7b8 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2165,9 +2165,14 @@ testing for syntax only valid as JSX." ;; JSXExpressionContainer here will be parsed in the ;; next iteration of the loop. (if (memq (char-after) '(?\" ?\' ?\`)) - (condition-case nil - (forward-sexp) - (scan-error (throw 'stop nil))) + (progn + ;; Record the string’s position so derived modes + ;; applying syntactic fontification atypically + ;; (e.g. js2-mode) can recognize it as part of JSX. + (put-text-property (point) (1+ (point)) 'js-jsx-string t) + (condition-case nil + (forward-sexp) + (scan-error (throw 'stop nil)))) ;; Save JSXAttribute’s beginning in case we find a ;; JSXExpressionContainer as the JSXAttribute’s value which ;; we should associate with the JSXAttribute. @@ -2195,7 +2200,7 @@ testing for syntax only valid as JSX." (defconst js-jsx--text-properties (list 'js-jsx-tag-beg nil 'js-jsx-tag-end nil 'js-jsx-close-tag-pos nil - 'js-jsx-tag-name nil 'js-jsx-attribute-name nil + 'js-jsx-tag-name nil 'js-jsx-attribute-name nil 'js-jsx-string nil 'js-jsx-text nil 'js-jsx-expr nil 'js-jsx-expr-attribute nil) "Plist of text properties added by `js-syntax-propertize'.") From 18bbfc4c754ea653ee0a7e2e47d1d61304f5c42a Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Mon, 8 Apr 2019 08:36:38 -0700 Subject: [PATCH 085/121] Permit non-ASCII identifiers in JS * lisp/progmodes/js.el (js--name-start-re): Generally allow identifiers to begin with non-ASCII letters. This is of particular importance to JSX parsing. * test/manual/indent/jsx-unclosed-2.jsx: Add test to ensure non-ASCII characters are parsed properly. --- lisp/progmodes/js.el | 2 +- test/manual/indent/jsx-unclosed-2.jsx | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index b1068bfc7b8..9185371b523 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -65,7 +65,7 @@ ;;; Constants -(defconst js--name-start-re (concat "[a-zA-Z_$]") +(defconst js--name-start-re (concat "[[:alpha:]_$]") "Regexp matching the start of a JavaScript identifier, without grouping.") (defconst js--stmt-delim-chars "^;{}?:") diff --git a/test/manual/indent/jsx-unclosed-2.jsx b/test/manual/indent/jsx-unclosed-2.jsx index be0a605503f..fb665b96a43 100644 --- a/test/manual/indent/jsx-unclosed-2.jsx +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -56,3 +56,10 @@ while (await foo > bar) void 0 / > < / div> < / div > + +// Non-ASCII identifiers are acceptable. +<Über> + + Guten Tag! + + From 9545519572d47b4712f27e53e7b64bf88d473877 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Mon, 8 Apr 2019 20:01:13 -0700 Subject: [PATCH 086/121] =?UTF-8?q?Add=20open/close=20parenthesis=20syntax?= =?UTF-8?q?=20to=20=E2=80=9C<=E2=80=9D=20and=20=E2=80=9C>=E2=80=9D=20in=20?= =?UTF-8?q?JSX?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx--syntax-propertize-tag): Like in sgml-mode, treat “<” and “>” like open/close parenthesis, making the text more navigable via forward-sexp, etc. --- lisp/progmodes/js.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 9185371b523..1cec41d9270 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2099,6 +2099,8 @@ testing for syntax only valid as JSX." (< (point) end))) (cond ((= (char-after) ?>) + ;; Make the closing “>” a close parenthesis. + (put-text-property (point) (1+ (point)) 'syntax-table '(5)) (forward-char) (setq unambiguous t) (throw 'stop nil)) @@ -2183,6 +2185,8 @@ testing for syntax only valid as JSX." (when unambiguous ;; Save JSXBoundaryElement’s name’s match data for font-locking. (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) + ;; Make the opening “<” an open parenthesis. + (put-text-property tag-beg (1+ tag-beg) 'syntax-table '(4)) ;; Prevent “out of range” errors when typing at the end of a buffer. (setq tag-end (if (eobp) (1- (point)) (point))) ;; Mark beginning and end of tag for font-locking. From 7c3ffdaf4b17e9f93aa929fc9a5c154e8e68e5fb Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Mon, 8 Apr 2019 22:27:41 -0700 Subject: [PATCH 087/121] =?UTF-8?q?Move=20curly=20functions=20closer=20to?= =?UTF-8?q?=20where=20they=E2=80=99re=20used?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx--enclosing-curly-pos) (js-jsx--goto-outermost-enclosing-curly): As the code evolved, these functions’ definitions ended up being far away from the only places where they were used. Move them there. --- lisp/progmodes/js.el | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1cec41d9270..a1f5e694ede 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1956,26 +1956,6 @@ the match. Return nil if a match can’t be found." (setq tag-stack (1+ tag-stack)))) (setq last-pos (point))))))) -(defun js-jsx--enclosing-curly-pos () - "Return position of enclosing “{” in a “{/}” pair about point." - (let ((parens (reverse (nth 9 (syntax-ppss)))) paren-pos curly-pos) - (while - (and - (setq paren-pos (car parens)) - (not (when (= (char-after paren-pos) ?{) - (setq curly-pos paren-pos))) - (setq parens (cdr parens)))) - curly-pos)) - -(defun js-jsx--goto-outermost-enclosing-curly (limit) - "Set point to enclosing “{” at or closest after LIMIT." - (let (pos) - (while - (and - (setq pos (js-jsx--enclosing-curly-pos)) - (if (>= pos limit) (goto-char pos)) - (> pos limit))))) - (defun js-jsx--enclosing-tag-pos () "Return beginning and end of a JSXElement about point. Look backward for a JSXElement that both starts before point and @@ -2646,6 +2626,26 @@ The column calculation is based off of `sgml-calculate-indent'." )) +(defun js-jsx--enclosing-curly-pos () + "Return position of enclosing “{” in a “{/}” pair about point." + (let ((parens (reverse (nth 9 (syntax-ppss)))) paren-pos curly-pos) + (while + (and + (setq paren-pos (car parens)) + (not (when (= (char-after paren-pos) ?{) + (setq curly-pos paren-pos))) + (setq parens (cdr parens)))) + curly-pos)) + +(defun js-jsx--goto-outermost-enclosing-curly (limit) + "Set point to enclosing “{” at or closest after LIMIT." + (let (pos) + (while + (and + (setq pos (js-jsx--enclosing-curly-pos)) + (if (>= pos limit) (goto-char pos)) + (> pos limit))))) + (defun js-jsx--expr-attribute-pos (start limit) "Look back from START to LIMIT for a JSXAttribute." (save-excursion From cf416d96c2d5db2079ed37927f0926fe0386e68a Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Mon, 8 Apr 2019 22:40:51 -0700 Subject: [PATCH 088/121] Explain reasonings for JSX syntax support design decisions * lisp/progmodes/js.el: Throughout the code, provide explanations for why JSX support was implemented in the way that it was; in particular, address the overlap between syntax-propertize-function, font-lock, and indentation (as requested by Stefan). --- lisp/progmodes/js.el | 109 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 109 insertions(+) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index a1f5e694ede..535b70317a7 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1536,6 +1536,25 @@ point of view of font-lock. It applies highlighting directly with ;; Matcher always "fails" nil) +;; It wouldn’t be sufficient to font-lock JSX with mere regexps, since +;; a JSXElement may be nested inside a JS expression within the +;; boundaries of a parent JSXOpeningElement, and such a hierarchy +;; ought to be fontified like JSX, JS, and JSX respectively: +;; +;;
) && void(0)}>
+;; +;;
← JSX +;; ) && void(0) ← JS +;; }>
← JSX +;; +;; `js-syntax-propertize' unambiguously identifies JSX syntax, +;; including when it’s nested. +;; +;; Using a matcher function for each relevant part, retrieve match +;; data recorded as syntax properties for fontification. + (defconst js-jsx--font-lock-keywords `((js-jsx--match-tag-name 0 font-lock-function-name-face t) (js-jsx--match-attribute-name 0 font-lock-variable-name-face t) @@ -1861,6 +1880,27 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) +;; Adding `syntax-multiline' text properties to JSX isn’t sufficient +;; to identify multiline JSX when first typing it. For instance, if +;; the user is typing a JSXOpeningElement for the first time… +;; +;;
← Despite completing the JSX, the next +;; ^ `syntax-propertize' region wouldn’t magically +;; extend back a few lines. +;; +;; Therefore, to try and recover from this scenario, parse backward +;; from “>” to try and find the start of JSXBoundaryElements, and +;; extend the `syntax-propertize' region there. + (defun js--syntax-propertize-extend-region (start end) "Extend the START-END region for propertization, if necessary. For use by `syntax-propertize-extend-region-functions'." @@ -1903,6 +1943,23 @@ For use by `syntax-propertize-extend-region-functions'." (throw 'stop nil))))))) (if new-start (cons new-start end)))) +;; When applying syntax properties, since `js-syntax-propertize' uses +;; `syntax-propertize-rules' to parse JSXBoundaryElements iteratively +;; and statelessly, whenever we exit such an element, we need to +;; determine the JSX depth. If >0, then we know we to apply syntax +;; properties to JSXText up until the next JSXBoundaryElement occurs. +;; But if the JSX depth is 0, then—importantly—we know to NOT parse +;; the following code as JSXText, rather propertize it as regular JS +;; as long as warranted. +;; +;; Also, when indenting code, we need to know if the code we’re trying +;; to indent is on the 2nd or later line of multiline JSX, in which +;; case the code is indented according to XML-like JSX conventions. +;; +;; For the aforementioned reasons, we find ourselves needing to +;; determine whether point is enclosed in JSX or not; and, if so, +;; where the JSX is. The following functions provide that knowledge. + (defconst js-jsx--tag-start-re (concat "\\(" js--dotted-name-re "\\)\\(?:" ;; Whitespace is only necessary if an attribute implies JSX. @@ -2004,6 +2061,24 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." (let ((pos (save-excursion (js-jsx--enclosing-tag-pos)))) (and pos (>= (point) (nth 1 pos))))) +;; We implement `syntax-propertize-function' logic fully parsing JSX +;; in order to provide very accurate JSX indentation, even in the most +;; complex cases (e.g. to indent JSX within a JS expression within a +;; JSXAttribute…), as over the years users have requested this. Since +;; we find so much information during this parse, we later use some of +;; the useful bits for font-locking, too. +;; +;; Some extra effort is devoted to ensuring that no code which could +;; possibly be valid JS is ever misinterpreted as partial JSX, since +;; that would be regressive. +;; +;; We first parse trying to find the minimum number of components +;; necessary to unambiguously identify a JSXBoundaryElement, even if +;; it is a partial one. If a complete one is parsed, we move on to +;; parse any JSXText. When that’s terminated, we unwind back to the +;; `syntax-propertize-rules' loop so the next JSXBoundaryElement can +;; be parsed, if any, be it an opening or closing one. + (defun js-jsx--text-range (beg end) "Identify JSXText within a “>/{/}/<” pair." (when (> (- end beg) 0) @@ -2023,6 +2098,10 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." ;; JSXText determines JSXText context from earlier lines. (put-text-property beg end 'syntax-multiline t))) +;; In order to respect the end boundary `syntax-propertize-function' +;; sets, care is taken in the following functions to abort parsing +;; whenever that boundary is reached. + (defun js-jsx--syntax-propertize-tag-text (end) "Determine if JSXText is before END and propertize it. Text within an open/close tag pair may be JSXText. Temporarily @@ -2562,6 +2641,21 @@ current line is the \"=>\" token (of an arrow function)." (end-of-line) (re-search-backward js--line-terminating-arrow-re from t))) +;; When indenting, we want to know if the line is… +;; +;; - within a multiline JSXElement, or +;; - within a string in a JSXBoundaryElement, or +;; - within JSXText, or +;; - within a JSXAttribute’s multiline JSXExpressionContainer. +;; +;; In these cases, special XML-like indentation rules for JSX apply. +;; If JS is nested within JSX, then indentation calculations may be +;; combined, such that JS indentation is “relative” to the JSX’s. +;; +;; Therefore, functions below provide such contextual information, and +;; `js--proper-indentation' may call itself once recursively in order +;; to finish calculating that “relative” JS+JSX indentation. + (defun js-jsx--context () "Determine JSX context and move to enclosing JSX." (let ((pos (point)) @@ -4319,6 +4413,10 @@ their `mode-name' updates to show enabled syntax extensions." (interactive) (setq-local js-jsx-syntax t)) +;; To make discovering and using syntax extensions features easier for +;; users (who might not read the docs), try to safely and +;; automatically enable syntax extensions based on heuristics. + (defvar js-jsx-regexps (list "\\_<\\(?:var\\|let\\|const\\|import\\)\\_>.*?React") "Regexps for detecting JSX in JavaScript buffers. @@ -4444,6 +4542,17 @@ This function is intended for use in `after-change-functions'." ;;(syntax-propertize (point-max)) ) +;; Since we made JSX support available and automatically-enabled in +;; the base `js-mode' (for ease of use), now `js-jsx-mode' simply +;; serves as one other interface to unconditionally enable JSX in +;; buffers, mostly for backwards-compatibility. +;; +;; Since it is probably more common for packages to integrate with +;; `js-mode' than with `js-jsx-mode', it is therefore probably +;; slightly better for users to use one of the many other methods for +;; enabling JSX syntax. But using `js-jsx-mode' can’t be that bad +;; either, so we won’t bother users with an obsoletion warning. + ;;;###autoload (define-derived-mode js-jsx-mode js-mode "JavaScript" "Major mode for editing JavaScript+JSX. From 062369e3aebdbcf25538e71686208a2126d83619 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 9 Apr 2019 00:52:43 -0700 Subject: [PATCH 089/121] * etc/NEWS: Document new and improved JSX support in js-mode --- etc/NEWS | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index c7456c681a2..42e7a4f995a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1259,6 +1259,51 @@ near the current column in Tabulated Lists (see variables This defcustom allows for the customization of the modifier key used in a terminal frame. +** JS mode + +*** JSX syntax is now automatically detected and enabled. +If a file imports Facebook's 'React' library, or if the file uses the +extension '.jsx', then various features supporting XML-like syntax +will be supported in 'js-mode' and derivative modes. ('js-jsx-mode' +no longer needs to be enabled.) + +*** New defcustom 'js-jsx-detect-syntax' disables automatic detection. + +*** New defcustom 'js-jsx-syntax' enables JSX syntax unconditionally. + +*** New variable 'js-jsx-regexps' controls JSX detection. + +*** JSX syntax is now highlighted like SGML. + +*** JSX code is properly indented in many more scenarios. +Previously, JSX indentation usually only worked when an element was +wrapped in parenthesis (e.g. in a 'return' statement or a function +call). It would also fail in many intricate cases. Now, indentation +should work anywhere without parenthesis; many more intricacies are +supported; and, indentation conventions align more closely with those +of the React developer community, otherwise still adhering to SGML +conventions. + +*** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. +It was never really intuitive that JSX indentation would be controlled +by an SGML variable. JSX is a syntax extension of JavaScript, so it +should be indented just like any other expression in JavaScript. This +is technically a breaking change, but it will probably align with how +you would normally expect for this indentation to be controlled, and +you probably won't need to change your config. + +*** New defcustom 'js-jsx-attribute-offset' for JSX attribute indents. + +*** New variable 'js-syntactic-mode-name' controls mode name display. +Previously, the mode name was simply 'JavaScript'. Now, when a syntax +extension like JSX is enabled, the mode name is 'JavaScript[JSX]'. +Setting this variable to nil can disable the new formatting. + +*** New function 'js-use-syntactic-mode-name' for deriving modes. +Packages deriving from 'js-mode' with 'define-derived-mode' should +call this function to add enabled syntax extensions to their mode +name, too. + * New Modes and Packages in Emacs 27.1 From 1e58dc9e11caa78e458e35ef4c7f32269e052d89 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 9 Apr 2019 11:01:24 +0300 Subject: [PATCH 090/121] Fix "M-x eshell" * lisp/eshell/em-dirs.el (eshell-variable-aliases-list) (eshell-directory-name, eshell-mode): Defvar them. (eshell-dirs-initialize): Require esh-var. (Bug#35203) (eshell-apply-indices): Declare. --- lisp/eshell/em-dirs.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 937bc981c53..93b10b59948 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -46,6 +46,11 @@ (require 'ring) (require 'esh-opt) +(declare-function eshell-apply-indices "esh-var") +(defvar eshell-variable-aliases-list) +(defvar eshell-directory-name) +(defvar eshell-mode) + ;;;###autoload (progn (defgroup eshell-dirs nil @@ -171,6 +176,7 @@ Thus, this does not include the current directory.") (defun eshell-dirs-initialize () "Initialize the builtin functions for Eshell." + (require 'esh-var) (make-local-variable 'eshell-variable-aliases-list) (setq eshell-variable-aliases-list (append From 44b306d3510e54432b76724583ea9405f1c90686 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 9 Apr 2019 11:09:56 +0300 Subject: [PATCH 091/121] ; * etc/NEWS: Fix recently added entries. --- etc/NEWS | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 42e7a4f995a..620d88c32a2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1261,20 +1261,28 @@ in a terminal frame. ** JS mode +--- *** JSX syntax is now automatically detected and enabled. If a file imports Facebook's 'React' library, or if the file uses the extension '.jsx', then various features supporting XML-like syntax will be supported in 'js-mode' and derivative modes. ('js-jsx-mode' no longer needs to be enabled.) +--- *** New defcustom 'js-jsx-detect-syntax' disables automatic detection. +This is turned on by default. +--- *** New defcustom 'js-jsx-syntax' enables JSX syntax unconditionally. +This is off by default. +--- *** New variable 'js-jsx-regexps' controls JSX detection. +--- *** JSX syntax is now highlighted like SGML. +--- *** JSX code is properly indented in many more scenarios. Previously, JSX indentation usually only worked when an element was wrapped in parenthesis (e.g. in a 'return' statement or a function @@ -1284,6 +1292,7 @@ supported; and, indentation conventions align more closely with those of the React developer community, otherwise still adhering to SGML conventions. +--- *** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. It was never really intuitive that JSX indentation would be controlled by an SGML variable. JSX is a syntax extension of JavaScript, so it @@ -1292,13 +1301,16 @@ is technically a breaking change, but it will probably align with how you would normally expect for this indentation to be controlled, and you probably won't need to change your config. +--- *** New defcustom 'js-jsx-attribute-offset' for JSX attribute indents. +--- *** New variable 'js-syntactic-mode-name' controls mode name display. Previously, the mode name was simply 'JavaScript'. Now, when a syntax extension like JSX is enabled, the mode name is 'JavaScript[JSX]'. -Setting this variable to nil can disable the new formatting. +Set this variable to nil to disable the new behavior. +--- *** New function 'js-use-syntactic-mode-name' for deriving modes. Packages deriving from 'js-mode' with 'define-derived-mode' should call this function to add enabled syntax extensions to their mode From c81465580fe262f28ce47502c00f4afcbe3b8f8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 9 Apr 2019 16:56:37 +0200 Subject: [PATCH 092/121] Clarify the TESTFN argument to `alist-get' * lisp/subr.el (alist-get): Rephrase the initial text to clarify the meaning of the TESTFN argument. It's an equality predicate, not a look-up function (Bug#35206). --- lisp/subr.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 45b39161965..bdf98979c49 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -779,9 +779,9 @@ Elements of ALIST that are not conses are ignored." alist) (defun alist-get (key alist &optional default remove testfn) - "Return the value associated with KEY in ALIST. + "Find the first element of ALIST whose `car' equals KEY and return its `cdr'. If KEY is not found in ALIST, return DEFAULT. -Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'. +Equality with KEY is tested by TESTFN, defaulting to `eq'. You can use `alist-get' in PLACE expressions. This will modify an existing association (more precisely, the first one if From 90c7e363b72f0a145378314a2710ce699b659ba1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 11:09:11 -0400 Subject: [PATCH 093/121] * lisp/vc/diff-mode.el: Cosmetic changes in diff-syntax-fontify-hunk (diff-default-directory): Use defvar-local. (diff-syntax-fontify-hunk): Use 'setq' less. Fit within 80 columns. Simplify some looking-at tests. (diff-syntax-fontify-props): Don't check the buffer-local part of find-file-hook. --- lisp/vc/diff-mode.el | 195 +++++++++++++++++++++++++------------------ 1 file changed, 113 insertions(+), 82 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 840f2c67d20..eeac24376e7 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -144,9 +144,8 @@ in wrong fontification. This is the fastest option, but less reliable." (defvar diff-vc-revisions nil "The VC revisions compared in the current Diff buffer, if any.") -(defvar diff-default-directory nil +(defvar-local diff-default-directory nil "The default directory where the current Diff buffer was created.") -(make-variable-buffer-local 'diff-default-directory) (defvar diff-outline-regexp "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)") @@ -2423,7 +2422,9 @@ When OLD is non-nil, highlight the hunk from the old source." (let* ((hunk (buffer-substring-no-properties beg end)) ;; Trim a trailing newline to find hunk in diff-syntax-fontify-props ;; in diffs that have no newline at end of diff file. - (text (string-trim-right (or (with-demoted-errors (diff-hunk-text hunk (not old) nil)) ""))) + (text (string-trim-right + (or (with-demoted-errors (diff-hunk-text hunk (not old) nil)) + ""))) (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?") (if old (match-string 1) (if (match-end 3) (match-string 3) (match-string 1))))) @@ -2432,83 +2433,112 @@ When OLD is non-nil, highlight the hunk from the old source." (list (string-to-number (match-string 1 line)) (string-to-number (match-string 2 line))) (list (string-to-number line) 1)))) ; One-line diffs - props) - (cond - ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only))) - (let* ((file (diff-find-file-name old t)) - (revision (and file (if (not old) (nth 1 diff-vc-revisions) - (or (nth 0 diff-vc-revisions) - (vc-working-revision file)))))) - (if file - (if (not revision) - ;; Get properties from the current working revision - (when (and (not old) (file-exists-p file) (file-regular-p file)) - ;; Try to reuse an existing buffer - (if (get-file-buffer (expand-file-name file)) - (with-current-buffer (get-file-buffer (expand-file-name file)) - (setq props (diff-syntax-fontify-props nil text line-nb))) - ;; Get properties from the file - (with-temp-buffer - (insert-file-contents file) - (setq props (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - (expand-file-name file) revision)) - (buffer (gethash buffer-name diff-syntax-fontify-revisions))) - (unless (and buffer (buffer-live-p buffer)) - (let* ((vc-buffer (ignore-errors - (vc-find-revision-no-save - (expand-file-name file) revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when vc-buffer - (setq buffer vc-buffer) - (puthash buffer-name buffer diff-syntax-fontify-revisions)))) - (when buffer - (with-current-buffer buffer - (setq props (diff-syntax-fontify-props file text line-nb)))))) - ;; If file is unavailable, get properties from the hunk alone - (setq file (car (diff-hunk-file-names old))) - (with-temp-buffer - (insert text) - (setq props (diff-syntax-fontify-props file text line-nb t)))))) - ((and diff-default-directory (not (eq diff-font-lock-syntax 'hunk-only))) - (let ((file (car (diff-hunk-file-names old)))) - (if (and file (file-exists-p file) (file-regular-p file)) - ;; Try to get full text from the file - (with-temp-buffer - (insert-file-contents file) - (setq props (diff-syntax-fontify-props file text line-nb))) - ;; Otherwise, get properties from the hunk alone - (with-temp-buffer - (insert text) - (setq props (diff-syntax-fontify-props file text line-nb t)))))) - ((memq diff-font-lock-syntax '(hunk-also hunk-only)) - (let ((file (car (diff-hunk-file-names old)))) - (with-temp-buffer - (insert text) - (setq props (diff-syntax-fontify-props file text line-nb t)))))) + (props + (cond + ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only))) + (let* ((file (diff-find-file-name old t)) + (revision (and file (if (not old) (nth 1 diff-vc-revisions) + (or (nth 0 diff-vc-revisions) + (vc-working-revision file)))))) + (if file + (if (not revision) + ;; Get properties from the current working revision + (when (and (not old) (file-exists-p file) + (file-regular-p file)) + (let ((buf (get-file-buffer (expand-file-name file)))) + ;; Try to reuse an existing buffer + (if buf + (with-current-buffer buf + (diff-syntax-fontify-props nil text line-nb)) + ;; Get properties from the file + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb))))) + ;; Get properties from a cached revision + (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" + (expand-file-name file) + revision)) + (buffer (gethash buffer-name + diff-syntax-fontify-revisions))) + (unless (and buffer (buffer-live-p buffer)) + (let* ((vc-buffer (ignore-errors + (vc-find-revision-no-save + (expand-file-name file) revision + diff-vc-backend + (get-buffer-create buffer-name))))) + (when vc-buffer + (setq buffer vc-buffer) + (puthash buffer-name buffer + diff-syntax-fontify-revisions)))) + (when buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb))))) + ;; If file is unavailable, get properties from the hunk alone + (setq file (car (diff-hunk-file-names old))) + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t))))) + ((and diff-default-directory + (not (eq diff-font-lock-syntax 'hunk-only))) + (let ((file (car (diff-hunk-file-names old)))) + (if (and file (file-exists-p file) (file-regular-p file)) + ;; Try to get full text from the file + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb)) + ;; Otherwise, get properties from the hunk alone + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t))))) + ((memq diff-font-lock-syntax '(hunk-also hunk-only)) + (let ((file (car (diff-hunk-file-names old)))) + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t))))))) ;; Put properties over the hunk text (goto-char beg) (when (and props (eq (diff-hunk-style) 'unified)) (while (< (progn (forward-line 1) (point)) end) - (when (or (and (not old) (not (looking-at-p "[-<]"))) - (and old (not (looking-at-p "[+>]")))) - (unless (looking-at-p "\\\\") ; skip "\ No newline at end of file" - (if (and old (not (looking-at-p "[-<]"))) - ;; Fontify context lines only from new source, - ;; don't refontify context lines from old source. - (pop props) - (let ((line-props (pop props)) - (bol (1+ (point)))) - (dolist (prop line-props) - (let ((ol (make-overlay (+ bol (nth 0 prop)) - (+ bol (nth 1 prop)) - nil 'front-advance nil))) - (overlay-put ol 'diff-mode 'syntax) - (overlay-put ol 'evaporate t) - (overlay-put ol 'face (nth 2 prop)))))))))))) + ;; Skip the "\ No newline at end of file" lines as well as the lines + ;; corresponding to the "other" version. + (unless (looking-at-p (if old "[+>\\]" "[-<\\]")) + (if (and old (not (looking-at-p "[-<]"))) + ;; Fontify context lines only from new source, + ;; don't refontify context lines from old source. + (pop props) + (let ((line-props (pop props)) + (bol (1+ (point)))) + (dolist (prop line-props) + ;; Ideally, we'd want to use text-properties as in: + ;; + ;; (add-face-text-property + ;; (+ bol (nth 0 prop)) (+ bol (nth 1 prop)) + ;; (nth 2 prop) 'append) + ;; + ;; rather than overlays here, but they'd get removed by later + ;; font-locking. + ;; This is because we also apply faces outside of the + ;; beg...end chunk currently font-locked and when font-lock + ;; later comes to handle the rest of the hunk that we already + ;; handled we don't (want to) redo it (we work at + ;; hunk-granularity rather than font-lock's own chunk + ;; granularity). + ;; I see two ways to fix this: + ;; - don't immediately apply the props that fall outside of + ;; font-lock's chunk but stash them somewhere (e.g. in another + ;; text property) and only later when font-lock comes back + ;; move them to `face'. + ;; - change the code so work at font-lock's chunk granularity + ;; (this seems doable without too much extra overhead, + ;; contrary to the refine highlighting, which inherently + ;; works at a different granularity). + (let ((ol (make-overlay (+ bol (nth 0 prop)) + (+ bol (nth 1 prop)) + nil 'front-advance nil))) + (overlay-put ol 'diff-mode 'syntax) + (overlay-put ol 'evaporate t) + (overlay-put ol 'face (nth 2 prop))))))))))) (defun diff-syntax-fontify-props (file text line-nb &optional hunk-only) "Get font-lock properties from the source code. @@ -2516,22 +2546,23 @@ FILE is the name of the source file. If non-nil, it requests initialization of the mode according to FILE. TEXT is the literal source text from hunk. LINE-NB is a pair of numbers: start line number and the number of -lines in the hunk. NO-INIT means no initialization is needed to set major -mode. When HUNK-ONLY is non-nil, then don't verify the existence of the +lines in the hunk. +When HUNK-ONLY is non-nil, then don't verify the existence of the hunk text in the source file. Otherwise, don't highlight the hunk if the hunk text is not found in the source file." (when file ;; When initialization is requested, we should be in a brand new ;; temp buffer. - (cl-assert (eq t buffer-undo-list)) - (cl-assert (not font-lock-mode)) (cl-assert (null buffer-file-name)) (let ((enable-local-variables :safe) ;; to find `mode:' (buffer-file-name file)) (set-auto-mode) - (when (and (memq 'generic-mode-find-file-hook - (append find-file-hook (default-value 'find-file-hook))) - (fboundp 'generic-mode-find-file-hook)) + ;; FIXME: Is this really worth the trouble? + (when (and (fboundp 'generic-mode-find-file-hook) + (memq #'generic-mode-find-file-hook + ;; There's no point checking the buffer-local value, + ;; we're in a fresh new buffer. + (default-value 'find-file-hook))) (generic-mode-find-file-hook)))) (let ((font-lock-defaults (or font-lock-defaults '(nil t))) From e1a457e63530cd566a1bc2957b70221bb6f76984 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 9 Apr 2019 16:32:27 +0100 Subject: [PATCH 094/121] ; Warn of while/dolist pitfall in gnus-sum.el Suggested by Andy Moreton in the following thread: https://lists.gnu.org/archive/html/emacs-devel/2019-04/msg00294.html * lisp/gnus/gnus-sum.el (gnus-summary-move-article): Add comment warning of common while/dolist pitfall. (bug#33653#134) --- lisp/gnus/gnus-sum.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 8959a2b3d0a..b8aa302f11a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10088,6 +10088,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) + ;; This `while' is not equivalent to a `dolist' (bug#33653#134). (while articles (setq article (pop articles)) ;; Set any marks that may have changed in the summary buffer. From 1055eee692b2cdcee5ba7ee4ad8d92ead8fc30e5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 12:04:03 -0400 Subject: [PATCH 095/121] * lisp/gnus/mm-view.el (mm-display-inline-fontify): Simplify. Remove hacks that were needed before font-lock-ensure. Don't use switch-to-buffer. Don't assume point-min == 1. --- lisp/gnus/mm-view.el | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 8ce094349f2..1e1d264b994 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -476,29 +476,32 @@ If MODE is not set, try to find mode automatically." (mm-decode-string text charset)) (t text))) - (require 'font-lock) - ;; I find font-lock a bit too verbose. - (let ((font-lock-verbose nil) - (font-lock-support-mode nil) + (let ((font-lock-verbose nil) ; font-lock is a bit too verbose. (enable-local-variables nil)) - ;; Disable support modes, e.g., jit-lock, lazy-lock, etc. - ;; Note: XEmacs people use `font-lock-mode-hook' to run those modes. + ;; We used to set font-lock-mode-hook to nil to avoid enabling + ;; support modes, but now that we use font-lock-ensure, support modes + ;; aren't a problem any more. So we could probably get rid of this + ;; setting now, but it seems harmless and potentially still useful. (set (make-local-variable 'font-lock-mode-hook) nil) (setq buffer-file-name (mm-handle-filename handle)) (with-demoted-errors - (if mode - (save-window-excursion - (switch-to-buffer (current-buffer)) - (funcall mode)) + (if mode + (save-window-excursion + ;; According to Katsumi Yamaoka , org-mode + ;; requires the buffer to be temporarily displayed here, but + ;; I could not reproduce this problem. Furthermore, if + ;; there's such a problem, we should fix org-mode rather than + ;; use switch-to-buffer which can have undesirable + ;; side-effects! + ;;(switch-to-buffer (current-buffer)) + (funcall mode)) (let ((auto-mode-alist (delq (rassq 'doc-view-mode-maybe auto-mode-alist) (copy-sequence auto-mode-alist)))) (set-auto-mode) (setq mode major-mode))) - ;; The mode function might have already turned on font-lock. ;; Do not fontify if the guess mode is fundamental. - (unless (or font-lock-mode - (eq major-mode 'fundamental-mode)) + (unless (eq major-mode 'fundamental-mode) (font-lock-ensure)))) (setq text (buffer-string)) (when (eq mode 'diff-mode) @@ -508,7 +511,7 @@ If MODE is not set, try to find mode automatically." ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. (set-buffer-modified-p nil)) - (let ((b (1- (point)))) + (let ((b (- (point) (save-restriction (widen) (point-min))))) (mm-insert-inline handle text) (dolist (ov ovs) (move-overlay (nth 0 ov) (+ (nth 1 ov) b) From 00a2d57adfe78bd137cd9458d9133f9c825b7d75 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 9 Apr 2019 16:56:37 +0200 Subject: [PATCH 096/121] Clarify the TESTFN argument to `alist-get' * lisp/subr.el (alist-get): Rephrase the initial text to clarify the meaning of the TESTFN argument. It's an equality predicate, not a look-up function (Bug#35206). (cherry picked from commit c81465580fe262f28ce47502c00f4afcbe3b8f8d) --- lisp/subr.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 44199a50754..54bee8a809f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -752,9 +752,9 @@ Elements of ALIST that are not conses are ignored." alist) (defun alist-get (key alist &optional default remove testfn) - "Return the value associated with KEY in ALIST. + "Find the first element of ALIST whose `car' equals KEY and return its `cdr'. If KEY is not found in ALIST, return DEFAULT. -Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'. +Equality with KEY is tested by TESTFN, defaulting to `eq'. This is a generalized variable suitable for use with `setf'. When using it to set a value, optional argument REMOVE non-nil From a017927c9ff627a0adf19ac3720bf6b2e77e5da5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 14:57:29 -0400 Subject: [PATCH 097/121] Fix up Eshell 'require's after previous dependency reshuffle. * lisp/eshell/em-unix.el: * lisp/eshell/em-script.el: * lisp/eshell/em-pred.el: * lisp/eshell/em-dirs.el: * lisp/eshell/em-alias.el: Fix up 'require's to silence byte-compiler. * lisp/eshell/esh-util.el (eshell-read-hosts-file): Don't limit number of entries per line. Preserve the structure. (eshell-read-hosts): Adjust accordingly. --- lisp/eshell/em-alias.el | 8 ++++---- lisp/eshell/em-banner.el | 2 +- lisp/eshell/em-cmpl.el | 2 +- lisp/eshell/em-dirs.el | 11 +++-------- lisp/eshell/em-glob.el | 2 +- lisp/eshell/em-hist.el | 2 +- lisp/eshell/em-pred.el | 8 +++----- lisp/eshell/em-prompt.el | 2 +- lisp/eshell/em-rebind.el | 2 +- lisp/eshell/em-script.el | 10 +++++----- lisp/eshell/em-smart.el | 2 +- lisp/eshell/em-term.el | 2 +- lisp/eshell/em-tramp.el | 2 +- lisp/eshell/em-unix.el | 5 ++--- lisp/eshell/esh-arg.el | 2 +- lisp/eshell/esh-cmd.el | 2 +- lisp/eshell/esh-ext.el | 2 +- lisp/eshell/esh-io.el | 2 +- lisp/eshell/esh-mode.el | 2 +- lisp/eshell/esh-proc.el | 2 +- lisp/eshell/esh-util.el | 18 ++++++++---------- lisp/eshell/esh-var.el | 2 +- 22 files changed, 41 insertions(+), 51 deletions(-) diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index dbffd52aa76..c465d464d6a 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -90,7 +90,7 @@ ;;; Code: -(require 'eshell) +(require 'esh-mode) ;;;###autoload (progn @@ -141,12 +141,12 @@ file named by `eshell-aliases-file'.") (defvar eshell-failed-commands-alist nil "An alist of command name failures.") -(defun eshell-alias-initialize () +(defun eshell-alias-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the alias handling code." (make-local-variable 'eshell-failed-commands-alist) - (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t) + (add-hook 'eshell-alternate-command-hook #'eshell-fix-bad-commands t t) (eshell-read-aliases-list) - (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t) + (add-hook 'eshell-named-command-hook #'eshell-maybe-replace-by-alias t t) (make-local-variable 'eshell-complex-commands) (add-to-list 'eshell-complex-commands 'eshell-command-aliased-p)) diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el index 4a0b265ae0e..c284c1bd70d 100644 --- a/lisp/eshell/em-banner.el +++ b/lisp/eshell/em-banner.el @@ -71,7 +71,7 @@ This can be any sexp, and should end with at least two newlines." :type 'hook :group 'eshell-banner) -(defun eshell-banner-initialize () +(defun eshell-banner-initialize () ;Called from `eshell-mode' via intern-soft! "Output a welcome banner on initialization." ;; it's important to use `eshell-interactive-print' rather than ;; `insert', because `insert' doesn't know how to interact with the diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 25a6e88c8e6..e3bfd8d9d48 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -244,7 +244,7 @@ to writing a completion function." (let ((completion-at-point-functions '(lisp-completion-at-point))) (completion-at-point))) -(defun eshell-cmpl-initialize () +(defun eshell-cmpl-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the completions module." (set (make-local-variable 'pcomplete-command-completion-function) eshell-command-completion-function) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 93b10b59948..c28fd72f45c 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -42,15 +42,11 @@ ;;; Code: -(require 'eshell) +(require 'esh-mode) ;For eshell-directory-name +(require 'esh-var) ;For eshell-variable-aliases-list (require 'ring) (require 'esh-opt) -(declare-function eshell-apply-indices "esh-var") -(defvar eshell-variable-aliases-list) -(defvar eshell-directory-name) -(defvar eshell-mode) - ;;;###autoload (progn (defgroup eshell-dirs nil @@ -174,9 +170,8 @@ Thus, this does not include the current directory.") ;;; Functions: -(defun eshell-dirs-initialize () +(defun eshell-dirs-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the builtin functions for Eshell." - (require 'esh-var) (make-local-variable 'eshell-variable-aliases-list) (setq eshell-variable-aliases-list (append diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index f03243a6af4..99c52ea0d30 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -125,7 +125,7 @@ This option slows down recursive glob processing by quite a bit." ;;; Functions: -(defun eshell-glob-initialize () +(defun eshell-glob-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the extended globbing code." ;; it's important that `eshell-glob-chars-list' come first (when (boundp 'eshell-special-chars-outside-quoting) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index bc0da96c588..614faaa131e 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -216,7 +216,7 @@ Returns non-nil if INPUT is blank." Returns nil if INPUT is prepended by blank space, otherwise non-nil." (not (string-match-p "\\`\\s-+" input))) -(defun eshell-hist-initialize () +(defun eshell-hist-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the history management code for one Eshell buffer." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index dd3351b14d3..9bc856a2966 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -46,9 +46,7 @@ ;;; Code: -(require 'esh-util) -(require 'esh-arg) -(eval-when-compile (require 'eshell)) +(require 'esh-mode) ;;;###autoload (progn @@ -247,10 +245,10 @@ EXAMPLES: (lambda () (insert eshell-modifier-help-string))))) -(defun eshell-pred-initialize () +(defun eshell-pred-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the predicate/modifier code." (add-hook 'eshell-parse-argument-hook - 'eshell-parse-arg-modifier t t) + #'eshell-parse-arg-modifier t t) (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help) (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help)) diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index a3035205adb..adc68b6c856 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -99,7 +99,7 @@ arriving, or after." ;;; Functions: -(defun eshell-prompt-initialize () +(defun eshell-prompt-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the prompting code." (unless eshell-non-interactive-p (add-hook 'eshell-post-command-hook 'eshell-emit-prompt nil t) diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 9cb16174f20..a817edbcc99 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -145,7 +145,7 @@ This is default behavior of shells like bash." ;;; Functions: -(defun eshell-rebind-initialize () +(defun eshell-rebind-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the inputting code." (unless eshell-non-interactive-p (add-hook 'eshell-mode-hook 'eshell-setup-input-keymap nil t) diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index bab26222baf..4a3b84e10e3 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -23,8 +23,7 @@ ;;; Code: -(require 'eshell) -(require 'esh-opt) +(require 'esh-mode) ;;;###autoload (progn @@ -57,7 +56,7 @@ This includes when running `eshell-command'." ;;; Functions: -(defun eshell-script-initialize () +(defun eshell-script-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the script parsing code." (make-local-variable 'eshell-interpreter-alist) (setq eshell-interpreter-alist @@ -73,13 +72,14 @@ This includes when running `eshell-command'." ;; to ruin it for other modules (let (eshell-inside-quote-regexp eshell-outside-quote-regexp) - (and (not eshell-non-interactive-p) + (and (not (bound-and-true-p eshell-non-interactive-p)) eshell-login-script (file-readable-p eshell-login-script) (eshell-do-eval (list 'eshell-commands (catch 'eshell-replace-command - (eshell-source-file eshell-login-script))) t)) + (eshell-source-file eshell-login-script))) + t)) (and eshell-rc-script (file-readable-p eshell-rc-script) (eshell-do-eval diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index 420f8850504..c7965b4187c 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -166,7 +166,7 @@ The options are `begin', `after' or `end'." ;;; Functions: -(defun eshell-smart-initialize () +(defun eshell-smart-initialize () ;Called from `eshell-mode' via intern-soft! "Setup Eshell smart display." (unless eshell-non-interactive-p ;; override a few variables, since they would interfere with the diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 9a9f23cddd9..dea90405ad7 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -147,7 +147,7 @@ behavior for short-lived processes, see bug#18108." ;;; Functions: -(defun eshell-term-initialize () +(defun eshell-term-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the `term' interface code." (make-local-variable 'eshell-interpreter-alist) (setq eshell-interpreter-alist diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 603b7627d5d..c7916360ee6 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -46,7 +46,7 @@ :tag "TRAMP Eshell features" :group 'eshell-module)) -(defun eshell-tramp-initialize () +(defun eshell-tramp-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the TRAMP-using commands code." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index e4c4265d702..25221817218 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -35,8 +35,7 @@ ;;; Code: -(require 'eshell) -(require 'esh-opt) +(require 'esh-mode) (require 'pcomplete) ;;;###autoload @@ -140,7 +139,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." ;;; Functions: -(defun eshell-unix-initialize () +(defun eshell-unix-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the UNIX support/emulation code." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 3ba4c935a72..026edc59808 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -157,7 +157,7 @@ treated as a literal character." ;;; Functions: -(defun eshell-arg-initialize () +(defun eshell-arg-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the argument parsing code." ;; This is supposedly run after enabling esh-mode, when eshell-mode-map ;; already exists. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 7b05cfbc341..6e03bda22b7 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -287,7 +287,7 @@ otherwise t.") "Return currently running command process, if non-Lisp." eshell-last-async-proc) -(defun eshell-cmd-initialize () +(defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the Eshell command processing module." (set (make-local-variable 'eshell-current-command) nil) (set (make-local-variable 'eshell-command-name) nil) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index ae8bf846249..978fc55c4de 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -172,7 +172,7 @@ external version." ;;; Functions: -(defun eshell-ext-initialize () +(defun eshell-ext-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the external command handling code." (add-hook 'eshell-named-command-hook #'eshell-explicit-command nil t)) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 1a6c71eda03..ce1d021384d 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -169,7 +169,7 @@ not be added to this variable." ;;; Functions: -(defun eshell-io-initialize () +(defun eshell-io-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the I/O subsystem code." (add-hook 'eshell-parse-argument-hook 'eshell-parse-redirection nil t) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 1f86dacd96c..cff29bed1b6 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -412,7 +412,7 @@ and the hook `eshell-exit-hook'." (when (and load-hook (boundp load-hook)) (if (memq initfunc (symbol-value load-hook)) (setq initfunc nil)) (run-hooks load-hook)) - ;; So we don't need the -initialize functions on the hooks (b#5375). + ;; So we don't need the -initialize functions on the hooks (bug#5375). (and initfunc (fboundp initfunc) (funcall initfunc)))) (if eshell-send-direct-to-subprocesses diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index d9a6eef7169..d538ae32b37 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -121,7 +121,7 @@ PROC and STATUS to functions on the latter." (eshell-reset-after-proc status) (run-hook-with-args 'eshell-kill-hook proc status)) -(defun eshell-proc-initialize () +(defun eshell-proc-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the process handling code." (make-local-variable 'eshell-process-list) ;; This is supposedly run after enabling esh-mode, when eshell-command-map diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 118978e77d0..6f355c70a42 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -478,24 +478,22 @@ list." (insert-file-contents (or filename eshell-hosts-file)) (goto-char (point-min)) (while (re-search-forward - "^\\([^#[:space:]]+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t) - (if (match-string 1) - (cl-pushnew (match-string 1) hosts :test #'equal)) - (if (match-string 2) - (cl-pushnew (match-string 2) hosts :test #'equal)) - (if (match-string 4) - (cl-pushnew (match-string 4) hosts :test #'equal)))) - (sort hosts #'string-lessp))) + ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^ \t\n]+\\)\\)?" + "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t) + (push (cons (match-string 1) + (split-string (match-string 2))) + hosts))) + (nreverse hosts))) (defun eshell-read-hosts (file result-var timestamp-var) - "Read the contents of /etc/passwd for user names." + "Read the contents of /etc/hosts for host names." (if (or (not (symbol-value result-var)) (not (symbol-value timestamp-var)) (time-less-p (symbol-value timestamp-var) (file-attribute-modification-time (file-attributes file)))) (progn - (set result-var (eshell-read-hosts-file file)) + (set result-var (apply #'nconc (eshell-read-hosts-file file))) (set timestamp-var (current-time)))) (symbol-value result-var)) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 82e0f7135ba..b08a5d242fe 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -199,7 +199,7 @@ function), and the arguments passed to this function would be the list ;;; Functions: -(defun eshell-var-initialize () +(defun eshell-var-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the variable handle code." ;; Break the association with our parent's environment. Otherwise, ;; changing a variable will affect all of Emacs. From c44313327588b5d2aafe9234e71f081f39a16082 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 15:02:00 -0400 Subject: [PATCH 098/121] * lisp/progmodes/js.el (js-mode): Don't set comment-start-skip globally! --- lisp/progmodes/js.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 535b70317a7..70998245818 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4483,6 +4483,7 @@ This function is intended for use in `after-change-functions'." ;; Comments (setq-local comment-start "// ") + (setq-local comment-start-skip "\\(//+\\|/\\*+\\)\\s *") (setq-local comment-end "") (setq-local fill-paragraph-function #'js-fill-paragraph) (setq-local normal-auto-fill-function #'js-do-auto-fill) @@ -4508,8 +4509,7 @@ This function is intended for use in `after-change-functions'." c-paragraph-separate "$" c-block-comment-prefix "* " c-line-comment-starter "//" - c-comment-start-regexp "/[*/]\\|\\s!" - comment-start-skip "\\(//+\\|/\\*+\\)\\s *") + c-comment-start-regexp "/[*/]\\|\\s!") (setq-local comment-line-break-function #'c-indent-new-comment-line) (setq-local c-block-comment-start-regexp "/\\*") (setq-local comment-multi-line t) From 4b39b741f1949ebad1dfccc5032dfce521bedc2a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 15:08:21 -0400 Subject: [PATCH 099/121] python.el: don't syntax-propertize single/double quoted strings * lisp/progmodes/python.el (python-syntax-propertize-function): Only mark triple-quoted strings, let the normal syntax-table handle the rest. (python-syntax-stringify): Adjust accordingly. --- lisp/progmodes/python.el | 40 ++++++++++++++++------------------------ 1 file changed, 16 insertions(+), 24 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5d0d03d5029..b05f9a33e90 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -675,7 +675,7 @@ Which one will be chosen depends on the value of (defconst python-syntax-propertize-function (syntax-propertize-rules - ((python-rx string-delimiter) + ((rx (or "\"\"\"" "'''")) (0 (ignore (python-syntax-stringify)))))) (define-obsolete-variable-alias 'python--prettify-symbols-alist @@ -701,35 +701,27 @@ is used to limit the scan." (defun python-syntax-stringify () "Put `syntax-table' property correctly on single/triple quotes." - (let* ((num-quotes (length (match-string-no-properties 1))) - (ppss (prog2 - (backward-char num-quotes) - (syntax-ppss) - (forward-char num-quotes))) - (string-start (and (not (nth 4 ppss)) (nth 8 ppss))) - (quote-starting-pos (- (point) num-quotes)) - (quote-ending-pos (point)) - (num-closing-quotes - (and string-start - (python-syntax-count-quotes - (char-before) string-start quote-starting-pos)))) - (cond ((and string-start (= num-closing-quotes 0)) - ;; This set of quotes doesn't match the string starting - ;; kind. Do nothing. + (let* ((ppss (save-excursion (backward-char 3) (syntax-ppss))) + (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss))) + (quote-starting-pos (- (point) 3)) + (quote-ending-pos (point))) + (cond ((or (nth 4 ppss) ;Inside a comment + (and string-start + ;; Inside of a string quoted with different triple quotes. + (not (eql (char-after string-start) + (char-after quote-starting-pos))))) + ;; Do nothing. nil) - ((not string-start) + ((nth 5 ppss) + ;; The first quote is escaped, so it's not part of a triple quote! + (goto-char (1+ quote-starting-pos))) + ((null string-start) ;; This set of quotes delimit the start of a string. (put-text-property quote-starting-pos (1+ quote-starting-pos) 'syntax-table (string-to-syntax "|"))) - ((= num-quotes num-closing-quotes) + (t ;; This set of quotes delimit the end of a string. (put-text-property (1- quote-ending-pos) quote-ending-pos - 'syntax-table (string-to-syntax "|"))) - ((> num-quotes num-closing-quotes) - ;; This may only happen whenever a triple quote is closing - ;; a single quoted string. Add string delimiter syntax to - ;; all three quotes. - (put-text-property quote-starting-pos quote-ending-pos 'syntax-table (string-to-syntax "|")))))) (defvar python-mode-syntax-table From 8a5ecdaa2faa550b4f3553beeda91c3c99c9bc05 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 15:11:38 -0400 Subject: [PATCH 100/121] quail.el: Use delete-and-extract-region * lisp/international/quail.el (quail-overlay-region-events): Use delete-and-extract-region. (quail-activate): Use setq-local. --- lisp/international/quail.el | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index bd05fcec698..3266b93b446 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -568,7 +568,7 @@ While this input method is active, the variable (quail-delete-overlays) (setq describe-current-input-method-function nil) (quail-hide-guidance) - (remove-hook 'post-command-hook 'quail-show-guidance t) + (remove-hook 'post-command-hook #'quail-show-guidance t) (run-hooks 'quail-deactivate-hook)) (kill-local-variable 'input-method-function)) ;; Let's activate Quail input method. @@ -579,19 +579,18 @@ While this input method is active, the variable (setq name (car (car quail-package-alist))) (error "No Quail package loaded")) (quail-select-package name))) - (setq deactivate-current-input-method-function 'quail-deactivate) - (setq describe-current-input-method-function 'quail-help) + (setq deactivate-current-input-method-function #'quail-deactivate) + (setq describe-current-input-method-function #'quail-help) (quail-delete-overlays) (setq quail-guidance-str "") (quail-show-guidance) ;; If we are in minibuffer, turn off the current input method ;; before exiting. (when (eq (selected-window) (minibuffer-window)) - (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer) - (add-hook 'post-command-hook 'quail-show-guidance nil t)) + (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer) + (add-hook 'post-command-hook #'quail-show-guidance nil t)) (run-hooks 'quail-activate-hook) - (make-local-variable 'input-method-function) - (setq input-method-function 'quail-input-method))) + (setq-local input-method-function #'quail-input-method))) (define-obsolete-variable-alias 'quail-inactivate-hook @@ -1367,9 +1366,7 @@ If STR has `advice' text property, append the following special event: (let ((start (overlay-start overlay)) (end (overlay-end overlay))) (if (< start end) - (prog1 - (string-to-list (buffer-substring start end)) - (delete-region start end))))) + (string-to-list (delete-and-extract-region start end))))) (defsubst quail-delete-region () "Delete the text in the current translation region of Quail." From 4f19bbb125a706f9657a299df1c5f03c81ed4a71 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 16:28:42 -0400 Subject: [PATCH 101/121] * lisp/printing.el: Use lexical-binding Require easy-menu instead of adding declarations. Remove backward compatiblity. Remove redundant ':group' args. (pr-region-active-p): Use use-region-p. (pr-set-keymap-name): Delete function and callers. (pr-set-keymap-parents): Delete function; use set-keymap-parent instead. (pr-read-string): Delete function; use read-string instead. (pr-menu-char-height): Delete function; use frame-char-height instead. (pr-menu-char-width): Delete function; use frame-char-width instead. (pr-menu-position): Merge the two definitions. (pr-get-symbol): Delete function; use easy-menu-intern instead. (pr-update-mode-line): Delete function; use force-mode-line-update instead. (pr-do-update-menus): Turn local save-var into dynbound pr--save-var. (pr-menu-alist): Use setf. Simplify since we don't keep key-bindings in the menus any more. (pr-dosify-file-name): Remove interactive spec. (pr-filename-style): Rename from pr-path-style. (pr-unixify-file-name): Delete function. (pr-standard-file-name): Don't turn \ into / under POSIX. (pr-temp-dir): Don't dosify. Use temporary-file-directory unconditionally. (pr-save-file-modes): Delete macro. (pr-ps-directory-using-ghostscript, pr-ps-directory-print) (pr-ps-directory-ps-print, pr-ps-mode-using-ghostscript, pr-ps-print) (pr-ps-mode-preview, pr-ps-mode-print, pr-printify-directory) (pr-txt-directory, pr-ps-file-up-preview, pr-ps-directory-preview) (pr-ps-file-up-ps-print, pr-ps-preview, pr-ps-using-ghostscript): Use properly prefixed, declared, and explicitly let-bound dynamically bound variables around calls to pr-ps-utility-args and pr-set-dir-args. (pr-ps-file-using-ghostscript): Only dosify when passing to suprocess. (pr-expand-file-name): Delete function; use expand-file-name instead. (pr-ps-file-print): Properly dosify. (pr-menu-create): Use backquotes. (pr-eval-alist, pr-eval-local-alist): Use dolist. (pr-ps-utility-args): Don't dosify here. (pr-ps-utility-process): Dosify here instead. (pr-ps-file, pr-command): Don't dosify here either. (pr-interface-map): Move initialization into declaration. (pr-insert-section-1): Use 'push'. (pr-insert-toggle): Use closure instead of backquoted lambda. (pr-insert-menu): Use apply i.s.o eval. (pr-insert-radio-button): Avoid 'eval'. --- lisp/printing.el | 1722 +++++++++++++++++----------------------------- 1 file changed, 638 insertions(+), 1084 deletions(-) diff --git a/lisp/printing.el b/lisp/printing.el index 27856eb09fc..f2495ecda38 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1,4 +1,4 @@ -;;; printing.el --- printing utilities +;;; printing.el --- printing utilities -*- lexical-binding:t -*- ;; Copyright (C) 2000-2001, 2003-2019 Free Software Foundation, Inc. @@ -460,7 +460,7 @@ Please send all bug fixes and enhancements to ;; subjects shows up at the printer. With major mode printing you don't need ;; to switch from gnus *Summary* buffer first. ;; -;; Current global keyboard mapping for GNU Emacs is: +;; Current global keyboard mapping is: ;; ;; (global-set-key [print] 'pr-ps-fast-fire) ;; (global-set-key [M-print] 'pr-ps-mode-using-ghostscript) @@ -468,14 +468,6 @@ Please send all bug fixes and enhancements to ;; (global-set-key [C-print] 'pr-txt-fast-fire) ;; (global-set-key [C-M-print] 'pr-txt-fast-fire) ;; -;; And for XEmacs is: -;; -;; (global-set-key 'f22 'pr-ps-fast-fire) -;; (global-set-key '(meta f22) 'pr-ps-mode-using-ghostscript) -;; (global-set-key '(shift f22) 'pr-ps-mode-using-ghostscript) -;; (global-set-key '(control f22) 'pr-txt-fast-fire) -;; (global-set-key '(control meta f22) 'pr-txt-fast-fire) -;; ;; As a suggestion of global keyboard mapping for some `printing' commands: ;; ;; (global-set-key "\C-ci" 'pr-interface) @@ -493,7 +485,7 @@ Please send all bug fixes and enhancements to ;; Below it's shown a brief description of `printing' options, please, see the ;; options declaration in the code for a long documentation. ;; -;; `pr-path-style' Specify which path style to use for external +;; `pr-filename-style' Specify which filename style to use for external ;; commands. ;; ;; `pr-path-alist' Specify an alist for command paths. @@ -999,7 +991,7 @@ Please send all bug fixes and enhancements to ;; - automagic region detection. ;; - menu entry hiding. ;; - fast fire PostScript printing command. -;; - `pr-path-style' variable. +;; - `pr-filename-style' variable. ;; ;; Thanks to Kim F. Storm for beta-test and for suggestions: ;; - PostScript Print and PostScript Print Preview merge. @@ -1023,7 +1015,7 @@ Please send all bug fixes and enhancements to (require 'lpr) (require 'ps-print) - +(require 'easymenu) (and (string< ps-print-version "6.6.4") (error "`printing' requires `ps-print' package version 6.6.4 or later")) @@ -1038,93 +1030,16 @@ Please send all bug fixes and enhancements to ;; To avoid compilation gripes -;; Emacs has this since at least 21.1. -(when (featurep 'xemacs) - (or (fboundp 'subst-char-in-string) ; hacked from subr.el - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. -Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> (setq i (1- i)) 0) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr)))) - - -;; Emacs has this since at least 21.1, but the SUFFIX argument -;; (which this file uses) only since 22.1. So the fboundp test -;; wasn't even correct/adequate. Whatever, no-one is using -;; this file on older Emacs version, so it's irrelevant. -(when (featurep 'xemacs) - (or (fboundp 'make-temp-file) ; hacked from subr.el - (defun make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. -The returned file name (created by appending some random characters at the end -of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. -You can then use `write-region' to write new data into the file. - -If DIR-FLAG is non-nil, create a new empty directory instead of a file. - -If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (while (condition-case () - (progn - (setq file - (make-temp-name - (expand-file-name prefix temporary-file-directory))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask)))))) - - -(eval-when-compile - ;; User Interface --- declared here to avoid compiler warnings - (defvar pr-path-style) - (defvar pr-auto-region) - (defvar pr-menu-char-height) - (defvar pr-menu-char-width) - (defvar pr-menu-lock) - (defvar pr-ps-printer-alist) - (defvar pr-txt-printer-alist) - (defvar pr-ps-utility-alist) - - - ;; Internal fun alias to avoid compilation gripes - (defalias 'pr-menu-lookup 'ignore) - (defalias 'pr-menu-lock 'ignore) - (defalias 'pr-menu-alist 'ignore) - (defalias 'pr-even-or-odd-pages 'ignore) - (defalias 'pr-menu-get-item 'ignore) - (defalias 'pr-menu-set-item-name 'ignore) - (defalias 'pr-menu-set-utility-title 'ignore) - (defalias 'pr-menu-set-ps-title 'ignore) - (defalias 'pr-menu-set-txt-title 'ignore) - (defalias 'pr-region-active-p 'ignore) - (defalias 'pr-do-update-menus 'ignore) - (defalias 'pr-update-mode-line 'ignore) - (defalias 'pr-read-string 'ignore) - (defalias 'pr-set-keymap-parents 'ignore) - (defalias 'pr-keep-region-active 'ignore)) - +;; User Interface --- declared here to avoid compiler warnings +(define-obsolete-variable-alias 'pr-path-style 'pr-filename-style "27.1") +(defvar pr-filename-style) +(defvar pr-auto-region) +(defvar pr-menu-char-height) +(defvar pr-menu-char-width) +(defvar pr-menu-lock) +(defvar pr-ps-printer-alist) +(defvar pr-txt-printer-alist) +(defvar pr-ps-utility-alist) ;; Internal Vars --- defined here to avoid compiler warnings (defvar pr-menu-print-item "print" @@ -1148,483 +1063,209 @@ Used by `pr-menu-bind' and `pr-update-menus'.") (even-sheet . "Print Even Sheets") (odd-sheet . "Print Odd Sheets"))) - -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; XEmacs Definitions - - -(cond - ((featurep 'xemacs) ; XEmacs - ;; XEmacs - (defalias 'pr-set-keymap-parents 'set-keymap-parents) - (defalias 'pr-set-keymap-name 'set-keymap-name) - - ;; XEmacs - (defun pr-read-string (prompt initial history default) - (let ((str (read-string prompt initial))) - (if (and str (not (string= str ""))) - str - default))) - - ;; XEmacs - (defvar zmacs-region-stays nil) - - ;; XEmacs - (defun pr-keep-region-active () - (setq zmacs-region-stays t)) - - ;; XEmacs - (defun pr-region-active-p () - (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p))) - - ;; XEmacs - (defun pr-menu-char-height () - (font-height (face-font 'default))) - - ;; XEmacs - (defun pr-menu-char-width () - (font-width (face-font 'default))) - - ;; XEmacs - (defmacro pr-xemacs-global-menubar (&rest body) - `(save-excursion - (let ((temp (get-buffer-create (make-temp-name " *Temp")))) - ;; be sure to access global menubar - (set-buffer temp) - ,@body - (kill-buffer temp)))) - - ;; XEmacs - (defun pr-global-menubar (pr-menu-spec) - ;; Menu binding - (pr-xemacs-global-menubar - (add-submenu nil (cons "Printing" pr-menu-spec) "Apps")) - (setq pr-menu-print-item nil)) - - ;; XEmacs - (defvar current-mouse-event nil) - (defun pr-menu-position (entry index horizontal) - (make-event - 'button-release - (list 'button 1 - 'x (- (event-x-pixel current-mouse-event) ; X - (* horizontal pr-menu-char-width)) - 'y (- (event-y-pixel current-mouse-event) ; Y - (* (pr-menu-index entry index) pr-menu-char-height))))) - - (defvar pr-menu-position nil) - (defvar pr-menu-state nil) - - ;; XEmacs - (defvar current-menubar nil) ; to avoid compilation gripes - (defun pr-menu-lookup (path) - (car (find-menu-item current-menubar (cons "Printing" path)))) - - ;; XEmacs - (defun pr-menu-lock (entry index horizontal state path) - (when pr-menu-lock - (or (and pr-menu-position (eq state pr-menu-state)) - (setq pr-menu-position (pr-menu-position entry index horizontal) - pr-menu-state state)) - (let* ((menu (pr-menu-lookup path)) - (result (get-popup-menu-response menu pr-menu-position))) - (and (misc-user-event-p result) - (funcall (event-function result) - (event-object result)))) - (setq pr-menu-position nil))) - - ;; XEmacs - (defalias 'pr-update-mode-line 'set-menubar-dirty-flag) - - ;; XEmacs - (defvar pr-ps-name-old "PostScript Printers") - (defvar pr-txt-name-old "Text Printers") - (defvar pr-ps-utility-old "PostScript Utility") - (defvar pr-even-or-odd-old "Print All Pages") - - ;; XEmacs - (defun pr-do-update-menus (&optional force) - (pr-menu-alist pr-ps-printer-alist - 'pr-ps-name - 'pr-menu-set-ps-title - '("Printing") - 'pr-ps-printer-menu-modified - force - pr-ps-name-old - 'postscript 2) - (pr-menu-alist pr-txt-printer-alist - 'pr-txt-name - 'pr-menu-set-txt-title - '("Printing") - 'pr-txt-printer-menu-modified - force - pr-txt-name-old - 'text 2) - (let ((save-var pr-ps-utility-menu-modified)) - (pr-menu-alist pr-ps-utility-alist - 'pr-ps-utility - 'pr-menu-set-utility-title - '("Printing" "PostScript Print" "File") - 'save-var - force - pr-ps-utility-old - nil 1)) - (pr-menu-alist pr-ps-utility-alist - 'pr-ps-utility - 'pr-menu-set-utility-title - '("Printing" "PostScript Preview" "File") - 'pr-ps-utility-menu-modified - force - pr-ps-utility-old - nil 1) - (pr-even-or-odd-pages ps-even-or-odd-pages force)) - - ;; XEmacs - (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name - entry index) - (when (and alist (or force (symbol-value modified-sym))) - (pr-xemacs-global-menubar - (add-submenu menu-path - (pr-menu-create name alist var-sym - fun entry index))) - (funcall fun (symbol-value var-sym)) - (set modified-sym nil))) - - ;; XEmacs - (defun pr-relabel-menu-item (newname var-sym) - (pr-xemacs-global-menubar - (relabel-menu-item - (list "Printing" (symbol-value var-sym)) - newname) - (set var-sym newname))) - - ;; XEmacs - (defun pr-menu-set-ps-title (value &optional item entry index) - (pr-relabel-menu-item (format "PostScript Printer: %s" value) - 'pr-ps-name-old) - (pr-ps-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) - - ;; XEmacs - (defun pr-menu-set-txt-title (value &optional item entry index) - (pr-relabel-menu-item (format "Text Printer: %s" value) - 'pr-txt-name-old) - (pr-txt-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) - - ;; XEmacs - (defun pr-menu-set-utility-title (value &optional item entry index) - (pr-xemacs-global-menubar - (let ((newname (format "%s" value))) - (relabel-menu-item - (list "Printing" "PostScript Print" "File" pr-ps-utility-old) - newname) - (relabel-menu-item - (list "Printing" "PostScript Preview" "File" pr-ps-utility-old) - newname) - (setq pr-ps-utility-old newname))) - (pr-ps-set-utility value) - (and index - (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) - - ;; XEmacs - (defun pr-even-or-odd-pages (value &optional no-lock) - (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist)) - 'pr-even-or-odd-old) - (setq ps-even-or-odd-pages value) - (or no-lock - (pr-menu-lock 'postscript-options 8 12 'toggle nil))) - - ) - (t ; GNU Emacs - ;; Do nothing - )) ; end cond featurep - - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; GNU Emacs Definitions -(eval-and-compile - (unless (featurep 'xemacs) - (defvar pr-menu-bar nil - "Specify Printing menu-bar entry."))) +(defun pr-keep-region-active () + (setq deactivate-mark nil)) -(cond - ((featurep 'xemacs) ; XEmacs - ;; Do nothing - ) - (t ; GNU Emacs - ;; GNU Emacs - (defalias 'pr-set-keymap-parents 'set-keymap-parent) - (defalias 'pr-set-keymap-name 'ignore) - (defalias 'pr-read-string 'read-string) +(defun pr-region-active-p () + (and pr-auto-region (use-region-p))) - ;; GNU Emacs - (defvar deactivate-mark) +;; Menu binding +;; Replace existing "print" item by "Printing" item. +;; If you're changing this file, you'll load it a second, +;; third... time, but "print" item exists only in the first load. - ;; GNU Emacs - (defun pr-keep-region-active () - (setq deactivate-mark nil)) +(defvar pr-menu-bar nil + "Specify Printing menu-bar entry.") - ;; GNU Emacs - (defun pr-region-active-p () - (and pr-auto-region transient-mark-mode mark-active)) - - ;; GNU Emacs - (defun pr-menu-char-height () - (frame-char-height)) - - ;; GNU Emacs - (defun pr-menu-char-width () - (frame-char-width)) - - ;; GNU Emacs - ;; Menu binding - ;; Replace existing "print" item by "Printing" item. - ;; If you're changing this file, you'll load it a second, - ;; third... time, but "print" item exists only in the first load. - (eval-when-compile - (require 'easymenu)) ; to avoid compilation gripes - - (declare-function easy-menu-add-item "easymenu" - (map path item &optional before)) - (declare-function easy-menu-remove-item "easymenu" (map path name)) - - (eval-and-compile - (defun pr-global-menubar (pr-menu-spec) - (require 'easymenu) - (let ((menu-file (if (= emacs-major-version 21) - '("menu-bar" "files") ; GNU Emacs 21 - '("menu-bar" "file")))) ; GNU Emacs 22 or higher - (cond - (pr-menu-print-item - (easy-menu-add-item global-map menu-file - (easy-menu-create-menu "Print" pr-menu-spec) - "print-buffer") - (dolist (item '("print-buffer" "print-region" - "ps-print-buffer-faces" "ps-print-region-faces" - "ps-print-buffer" "ps-print-region")) - (easy-menu-remove-item global-map menu-file item)) - (setq pr-menu-print-item nil - pr-menu-bar (vector 'menu-bar - (pr-get-symbol (nth 1 menu-file)) - (pr-get-symbol "Print")))) - (t - (easy-menu-add-item global-map menu-file - (easy-menu-create-menu "Print" pr-menu-spec))) - )))) - - (eval-and-compile +(defun pr-global-menubar (menu-spec) + (let ((menu-file '("menu-bar" "file"))) (cond - (lpr-windows-system - ;; GNU Emacs for Windows 9x/NT - (defun pr-menu-position (entry index horizontal) - (let ((pos (cdr (mouse-pixel-position)))) - (list - (list (or (car pos) 0) ; X - (- (or (cdr pos) 0) ; Y - (* (pr-menu-index entry index) pr-menu-char-height))) - (selected-frame)))) ; frame - ) + (pr-menu-print-item + (easy-menu-add-item global-map menu-file + (easy-menu-create-menu "Print" menu-spec) + "print-buffer") + (dolist (item '("print-buffer" "print-region" + "ps-print-buffer-faces" "ps-print-region-faces" + "ps-print-buffer" "ps-print-region")) + (easy-menu-remove-item global-map menu-file item)) + (setq pr-menu-print-item nil + pr-menu-bar (vector 'menu-bar + (easy-menu-intern (nth 1 menu-file)) + (easy-menu-intern "Print")))) (t - ;; GNU Emacs - (defun pr-menu-position (entry index horizontal) - (let ((pos (cdr (mouse-pixel-position)))) - (list - (list (- (or (car pos) 0) ; X - (* horizontal pr-menu-char-width)) - (- (or (cdr pos) 0) ; Y - (* (pr-menu-index entry index) pr-menu-char-height))) - (selected-frame)))) ; frame - ))) + (easy-menu-add-item global-map menu-file + (easy-menu-create-menu "Print" menu-spec))) + ))) - (defvar pr-menu-position nil) - (defvar pr-menu-state nil) +(defun pr-menu-position (entry index horizontal) + (let ((pos (cdr (mouse-pixel-position)))) + (list + (list (- (or (car pos) 0) ; X + (if lpr-windows-system + 0 ;; GNU Emacs for Windows 9x/NT + (* horizontal pr-menu-char-width))) + (- (or (cdr pos) 0) ; Y + (* (pr-menu-index entry index) pr-menu-char-height))) + (selected-frame)))) ; frame - ;; GNU Emacs - (defun pr-menu-lookup (path) - (lookup-key global-map - (if path - (vconcat pr-menu-bar - (mapcar 'pr-get-symbol - (if (listp path) - path - (list path)))) - pr-menu-bar))) +(defvar pr-menu-position nil) +(defvar pr-menu-state nil) - ;; GNU Emacs - (defun pr-menu-lock (entry index horizontal state path) - (when pr-menu-lock - (or (and pr-menu-position (eq state pr-menu-state)) - (setq pr-menu-position (pr-menu-position entry index horizontal) - pr-menu-state state)) - (let* ((menu (pr-menu-lookup path)) - (result (x-popup-menu pr-menu-position menu))) - (and result - (let ((command (lookup-key menu (vconcat result)))) - (if (fboundp command) - (funcall command) - (eval command))))) - (setq pr-menu-position nil))) +(defun pr-menu-lookup (path) + (lookup-key global-map + (if path + (vconcat pr-menu-bar + (mapcar #'easy-menu-intern + (if (listp path) + path + (list path)))) + pr-menu-bar))) - ;; GNU Emacs - (defalias 'pr-update-mode-line 'force-mode-line-update) +(defun pr-menu-lock (entry index horizontal state path) + (when pr-menu-lock + (or (and pr-menu-position (eq state pr-menu-state)) + (setq pr-menu-position (pr-menu-position entry index horizontal) + pr-menu-state state)) + (let* ((menu (pr-menu-lookup path)) + (result (x-popup-menu pr-menu-position menu))) + (and result + (let ((command (lookup-key menu (vconcat result)))) + (if (fboundp command) + (funcall command) + (eval command))))) + (setq pr-menu-position nil))) - ;; GNU Emacs - (defun pr-do-update-menus (&optional force) - (pr-menu-alist pr-ps-printer-alist - 'pr-ps-name - 'pr-menu-set-ps-title - "PostScript Printers" - 'pr-ps-printer-menu-modified - force - "PostScript Printers" - 'postscript 2) - (pr-menu-alist pr-txt-printer-alist - 'pr-txt-name - 'pr-menu-set-txt-title - "Text Printers" - 'pr-txt-printer-menu-modified - force - "Text Printers" - 'text 2) - (let ((save-var pr-ps-utility-menu-modified)) - (pr-menu-alist pr-ps-utility-alist - 'pr-ps-utility - 'pr-menu-set-utility-title - '("PostScript Print" "File" "PostScript Utility") - 'save-var - force - "PostScript Utility" - nil 1)) +(defun pr-do-update-menus (&optional force) + (pr-menu-alist pr-ps-printer-alist + 'pr-ps-name + #'pr-menu-set-ps-title + "PostScript Printers" + 'pr-ps-printer-menu-modified + force + "PostScript Printers" + 'postscript 2) + (pr-menu-alist pr-txt-printer-alist + 'pr-txt-name + #'pr-menu-set-txt-title + "Text Printers" + 'pr-txt-printer-menu-modified + force + "Text Printers" + 'text 2) + (defvar pr--save-var) + (let ((pr--save-var pr-ps-utility-menu-modified)) (pr-menu-alist pr-ps-utility-alist 'pr-ps-utility - 'pr-menu-set-utility-title - '("PostScript Preview" "File" "PostScript Utility") - 'pr-ps-utility-menu-modified + #'pr-menu-set-utility-title + '("PostScript Print" "File" "PostScript Utility") + 'pr--save-var force "PostScript Utility" - nil 1) - (pr-even-or-odd-pages ps-even-or-odd-pages force)) + nil 1)) + (pr-menu-alist pr-ps-utility-alist + 'pr-ps-utility + #'pr-menu-set-utility-title + '("PostScript Preview" "File" "PostScript Utility") + 'pr-ps-utility-menu-modified + force + "PostScript Utility" + nil 1) + (pr-even-or-odd-pages ps-even-or-odd-pages force)) - ;; GNU Emacs - (defun pr-menu-get-item (name-list) - ;; NAME-LIST is a string or a list of strings. - (or (listp name-list) - (setq name-list (list name-list))) - (and name-list - (let* ((reversed (reverse name-list)) - (name (pr-get-symbol (car reversed))) - (path (nreverse (cdr reversed))) - (menu (lookup-key - global-map - (vconcat pr-menu-bar - (mapcar 'pr-get-symbol path))))) - (assq name (nthcdr 2 menu))))) +(defun pr-menu-get-item (name-list) + ;; NAME-LIST is a string or a list of strings. + (or (listp name-list) + (setq name-list (list name-list))) + (and name-list + (let* ((reversed (reverse name-list)) + (name (easy-menu-intern (car reversed))) + (path (nreverse (cdr reversed))) + (menu (lookup-key + global-map + (vconcat pr-menu-bar + (mapcar #'easy-menu-intern path))))) + (assq name (nthcdr 2 menu))))) - ;; GNU Emacs - (defvar pr-temp-menu nil) +(defvar pr-temp-menu nil) - ;; GNU Emacs - (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name - entry index) - (when (and alist (or force (symbol-value modified-sym))) - (easy-menu-define pr-temp-menu nil "" - (pr-menu-create name alist var-sym fun entry index)) - (let ((item (pr-menu-get-item menu-path))) - (and item - (let* ((binding (nthcdr 3 item)) - (key-binding (cdr binding))) - (setcar binding pr-temp-menu) - (and key-binding (listp (car key-binding)) - (setcdr binding (cdr key-binding))) ; skip KEY-BINDING - (funcall fun (symbol-value var-sym) item)))) - (set modified-sym nil))) +(defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name + entry index) + (when (and alist (or force (symbol-value modified-sym))) + (easy-menu-define pr-temp-menu nil "" + (pr-menu-create name alist var-sym fun entry index)) + (let ((item (pr-menu-get-item menu-path))) + (and item + (progn + (setf (nth 3 item) pr-temp-menu) + (funcall fun (symbol-value var-sym) item)))) + (set modified-sym nil))) - ;; GNU Emacs - (defun pr-menu-set-item-name (item name) - (and item - (setcar (nthcdr 2 item) name))) ; ITEM-NAME +(defun pr-menu-set-item-name (item name) + (and item + (setcar (nthcdr 2 item) name))) ; ITEM-NAME - ;; GNU Emacs - (defun pr-menu-set-ps-title (value &optional item entry index) - (pr-menu-set-item-name (or item - (pr-menu-get-item "PostScript Printers")) - (format "PostScript Printer: %s" value)) - (pr-ps-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) +(defun pr-menu-set-ps-title (value &optional item entry index) + (pr-menu-set-item-name (or item + (pr-menu-get-item "PostScript Printers")) + (format "PostScript Printer: %s" value)) + (pr-ps-set-printer value) + (and index + (pr-menu-lock entry index 12 'toggle nil))) - ;; GNU Emacs - (defun pr-menu-set-txt-title (value &optional item entry index) - (pr-menu-set-item-name (or item - (pr-menu-get-item "Text Printers")) - (format "Text Printer: %s" value)) - (pr-txt-set-printer value) - (and index - (pr-menu-lock entry index 12 'toggle nil))) +(defun pr-menu-set-txt-title (value &optional item entry index) + (pr-menu-set-item-name (or item + (pr-menu-get-item "Text Printers")) + (format "Text Printer: %s" value)) + (pr-txt-set-printer value) + (and index + (pr-menu-lock entry index 12 'toggle nil))) - ;; GNU Emacs - (defun pr-menu-set-utility-title (value &optional item entry index) - (let ((name (symbol-name value))) - (if item - (pr-menu-set-item-name item name) - (pr-menu-set-item-name - (pr-menu-get-item - '("PostScript Print" "File" "PostScript Utility")) - name) - (pr-menu-set-item-name - (pr-menu-get-item - '("PostScript Preview" "File" "PostScript Utility")) - name))) - (pr-ps-set-utility value) - (and index - (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) - - ;; GNU Emacs - (defun pr-even-or-odd-pages (value &optional no-lock) - (pr-menu-set-item-name (pr-menu-get-item "Print All Pages") - (cdr (assq value pr-even-or-odd-alist))) - (setq ps-even-or-odd-pages value) - (or no-lock - (pr-menu-lock 'postscript-options 8 12 'toggle nil))) - - )) ; end cond featurep +(defun pr-menu-set-utility-title (value &optional item entry index) + (let ((name (symbol-name value))) + (if item + (pr-menu-set-item-name item name) + (pr-menu-set-item-name + (pr-menu-get-item + '("PostScript Print" "File" "PostScript Utility")) + name) + (pr-menu-set-item-name + (pr-menu-get-item + '("PostScript Preview" "File" "PostScript Utility")) + name))) + (pr-ps-set-utility value) + (and index + (pr-menu-lock entry index 5 nil '("PostScript Print" "File")))) +(defun pr-even-or-odd-pages (value &optional no-lock) + (pr-menu-set-item-name (pr-menu-get-item "Print All Pages") + (cdr (assq value pr-even-or-odd-alist))) + (setq ps-even-or-odd-pages value) + (or no-lock + (pr-menu-lock 'postscript-options 8 12 'toggle nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Functions (I) -(defun pr-dosify-file-name (path) +(defun pr-dosify-file-name (filename) "Replace unix-style directory separator character with dos/windows one." - (interactive "sPath: ") - (if (eq pr-path-style 'windows) - (subst-char-in-string ?/ ?\\ path) - path)) + (if (eq pr-filename-style 'windows) + (subst-char-in-string ?/ ?\\ filename) + filename)) - -(defun pr-unixify-file-name (path) - "Replace dos/windows-style directory separator character with unix one." - (interactive "sPath: ") - (if (eq pr-path-style 'windows) - (subst-char-in-string ?\\ ?/ path) - path)) - - -(defun pr-standard-file-name (path) +(defun pr-standard-file-name (filename) "Ensure the proper directory separator depending on the OS. That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory separator; otherwise, ensure unix-style directory separator." + ;; FIXME: Why not use pr-dosify-file-name? (if (or pr-cygwin-system lpr-windows-system) - (subst-char-in-string ?/ ?\\ path) - (subst-char-in-string ?\\ ?/ path))) - + (subst-char-in-string ?/ ?\\ filename) + filename)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Customization Functions @@ -1672,22 +1313,21 @@ separator; otherwise, ensure unix-style directory separator." :group 'postscript) -(defcustom pr-path-style +(defcustom pr-filename-style (if (and (not pr-cygwin-system) lpr-windows-system) 'windows 'unix) - "Specify which path style to use for external commands. + "Specify which filename style to use for external commands. Valid values are: windows Windows 9x/NT style (\\) unix Unix style (/)" - :type '(choice :tag "Path style" + :type '(choice :tag "Filename style" (const :tag "Windows 9x/NT Style (\\)" :value windows) - (const :tag "Unix Style (/)" :value unix)) - :group 'printing) + (const :tag "Unix Style (/)" :value unix))) (defcustom pr-path-alist @@ -1708,13 +1348,13 @@ Where: ENTRY It's a symbol, used to identify this entry. There must exist at least one of the following entries: - unix this entry is used when Emacs is running on GNU or + `unix' this entry is used when Emacs is running on GNU or Unix system. - cygwin this entry is used when Emacs is running on Windows + `cygwin' this entry is used when Emacs is running on Windows 95/98/NT/2000 with Cygwin. - windows this entry is used when Emacs is running on Windows + `windows' this entry is used when Emacs is running on Windows 95/98/NT/2000. DIRECTORY It should be a string or a symbol. If it's a symbol, it should @@ -1764,8 +1404,7 @@ Examples: (choice :menu-tag "Directory" :tag "Directory" (string :value "") - (symbol :value symbol))))) - :group 'printing) + (symbol :value symbol)))))) (defcustom pr-txt-name 'default @@ -1778,8 +1417,7 @@ This variable should be modified by customization engine. If this variable is modified by other means (for example, a lisp function), use `pr-update-menus' function (see it for documentation) to update text printer menu." :type 'symbol - :set 'pr-txt-name-custom-set - :group 'printing) + :set 'pr-txt-name-custom-set) (defcustom pr-txt-printer-alist @@ -1910,8 +1548,7 @@ Useful links: :tag "Printer Name" (const :tag "None" nil) string))) - :set 'pr-alist-custom-set - :group 'printing) + :set 'pr-alist-custom-set) (defcustom pr-ps-name 'default @@ -1924,8 +1561,7 @@ This variable should be modified by customization engine. If this variable is modified by other means (for example, a lisp function), use `pr-update-menus' function (see it for documentation) to update PostScript printer menu." :type 'symbol - :set 'pr-ps-name-custom-set - :group 'printing) + :set 'pr-ps-name-custom-set) (defcustom pr-ps-printer-alist @@ -2196,33 +1832,21 @@ Useful links: (variable :tag "Other")) (sexp :tag "Value"))) )) - :set 'pr-alist-custom-set - :group 'printing) + :set 'pr-alist-custom-set) -(defcustom pr-temp-dir - (pr-dosify-file-name - (if (boundp 'temporary-file-directory) - (symbol-value 'temporary-file-directory) - ;; hacked from `temporary-file-directory' variable in files.el - (file-name-as-directory - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") - (cond (lpr-windows-system "c:/temp") - (t "/tmp") - ))))) +(defcustom pr-temp-dir temporary-file-directory "Specify a directory for temporary files during printing. See also `pr-ps-temp-file' and `pr-file-modes'." - :type '(directory :tag "Temporary Directory") - :group 'printing) + :type '(directory :tag "Temporary Directory")) (defcustom pr-ps-temp-file "prspool-" "Specify PostScript temporary file name prefix. See also `pr-temp-dir' and `pr-file-modes'." - :type '(file :tag "PostScript Temporary File Name") - :group 'printing) + :type '(file :tag "PostScript Temporary File Name")) ;; It uses 0600 as default instead of (default-file-modes). @@ -2234,8 +1858,7 @@ See also `pr-temp-dir' and `pr-file-modes'." It should be an integer; only the low 9 bits are used. See also `pr-temp-dir' and `pr-ps-temp-file'." - :type '(integer :tag "File Permission Bits") - :group 'printing) + :type '(integer :tag "File Permission Bits")) (defcustom pr-gv-command @@ -2275,8 +1898,7 @@ Useful links: * MacGSView (Mac OS) `http://www.cs.wisc.edu/~ghost/macos/index.htm' " - :type '(string :tag "Ghostview Utility") - :group 'printing) + :type '(string :tag "Ghostview Utility")) (defcustom pr-gs-command @@ -2301,8 +1923,7 @@ Useful links: * Printer compatibility `http://www.cs.wisc.edu/~ghost/doc/printer.htm' " - :type '(string :tag "Ghostscript Utility") - :group 'printing) + :type '(string :tag "Ghostscript Utility")) (defcustom pr-gs-switches @@ -2343,8 +1964,7 @@ Useful links: * Printer compatibility `http://www.cs.wisc.edu/~ghost/doc/printer.htm' " - :type '(repeat (string :tag "Ghostscript Switch")) - :group 'printing) + :type '(repeat (string :tag "Ghostscript Switch"))) (defcustom pr-gs-device @@ -2359,8 +1979,7 @@ A note on the gs switches: See `pr-gs-switches' for documentation. See also `pr-ps-printer-alist'." - :type '(string :tag "Ghostscript Device") - :group 'printing) + :type '(string :tag "Ghostscript Device")) (defcustom pr-gs-resolution 300 @@ -2372,8 +1991,7 @@ A note on the gs switches: See `pr-gs-switches' for documentation. See also `pr-ps-printer-alist'." - :type '(integer :tag "Ghostscript Resolution") - :group 'printing) + :type '(integer :tag "Ghostscript Resolution")) (defcustom pr-print-using-ghostscript nil @@ -2384,32 +2002,27 @@ ghostscript to print a PostScript file. In GNU or Unix system, if ghostscript is set as a PostScript filter, this variable should be nil." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-faces-p nil "Non-nil means print with face attributes." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-spool-p nil "Non-nil means spool printing in a buffer." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-file-landscape nil "Non-nil means print PostScript file in landscape orientation." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-file-duplex nil "Non-nil means print PostScript file in duplex mode." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-file-tumble nil @@ -2419,8 +2032,7 @@ If tumble is off, produces a printing suitable for binding on the left or right. If tumble is on, produces a printing suitable for binding at the top or bottom." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-auto-region t @@ -2431,8 +2043,7 @@ Note that this will only work if you're using transient mark mode. When this variable is non-nil, the `*-buffer*' commands will behave like `*-region*' commands, that is, `*-buffer*' commands will print only the region marked instead of all buffer." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-auto-mode t @@ -2442,8 +2053,7 @@ That is, if current major-mode is declared in `pr-mode-alist', the `*-buffer*' and `*-region*' commands will behave like `*-mode*' commands; otherwise, `*-buffer*' commands will print the current buffer and `*-region*' commands will print the current region." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-mode-alist @@ -2642,8 +2252,7 @@ DEFAULT It's a way to set default values when this entry is selected. (const :tag "inherits-from:" inherits-from:) (variable :tag "Other")) (sexp :tag "Value"))) - )) - :group 'printing) + ))) (defcustom pr-ps-utility 'mpage @@ -2659,8 +2268,7 @@ function (see it for documentation) to update PostScript utility menu. NOTE: Don't forget to download and install the utilities declared on `pr-ps-utility-alist'." :type '(symbol :tag "PS File Utility") - :set 'pr-ps-utility-custom-set - :group 'printing) + :set 'pr-ps-utility-custom-set) (defcustom pr-ps-utility-alist @@ -2871,38 +2479,34 @@ Useful links: (variable :tag "Other")) (sexp :tag "Value"))) )) - :set 'pr-alist-custom-set - :group 'printing) + :set 'pr-alist-custom-set) (defcustom pr-menu-lock t "Non-nil means menu is locked while selecting toggle options. See also `pr-menu-char-height' and `pr-menu-char-width'." - :type 'boolean - :group 'printing) + :type 'boolean) -(defcustom pr-menu-char-height (pr-menu-char-height) +(defcustom pr-menu-char-height (frame-char-height) "Specify menu char height in pixels. This variable is used to guess which vertical position should be locked the menu, so don't forget to adjust it if menu position is not ok. See also `pr-menu-lock' and `pr-menu-char-width'." - :type 'integer - :group 'printing) + :type 'integer) -(defcustom pr-menu-char-width (pr-menu-char-width) +(defcustom pr-menu-char-width (frame-char-width) "Specify menu char width in pixels. This variable is used to guess which horizontal position should be locked the menu, so don't forget to adjust it if menu position is not ok. See also `pr-menu-lock' and `pr-menu-char-height'." - :type 'integer - :group 'printing) + :type 'integer) (defcustom pr-setting-database @@ -3017,8 +2621,7 @@ SETTING It's a cons like: (const :tag "Ghostscript Resolution" pr-gs-resolution) (variable :tag "Other")) (sexp :tag "Value"))) - )) - :group 'printing) + ))) (defcustom pr-visible-entry-list @@ -3070,8 +2673,7 @@ Any other value is ignored." (const postscript-options) (const postscript-process) (const printing) - (const help))) - :group 'printing) + (const help)))) (defcustom pr-delete-temp-file t @@ -3081,8 +2683,7 @@ Set `pr-delete-temp-file' to nil, if the following message (or a similar) happens when printing: Error: could not open \"c:\\temp\\prspool.ps\" for reading." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-list-directory nil @@ -3094,16 +2695,14 @@ argument of functions below) are also printed (as dired-mode listings). It's used by `pr-ps-directory-preview', `pr-ps-directory-using-ghostscript', `pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory' and `pr-txt-directory'." - :type 'boolean - :group 'printing) + :type 'boolean) (defcustom pr-buffer-name "*Printing Interface*" "Specify the name of the buffer interface for printing package. It's used by `pr-interface'." - :type 'string - :group 'printing) + :type 'string) (defcustom pr-buffer-name-ignore @@ -3115,16 +2714,14 @@ NOTE: Case is important for matching, that is, `case-fold-search' is always nil. It's used by `pr-interface'." - :type '(repeat (regexp :tag "Buffer Name Regexp")) - :group 'printing) + :type '(repeat (regexp :tag "Buffer Name Regexp"))) (defcustom pr-buffer-verbose t "Non-nil means to be verbose when editing a field in interface buffer. It's used by `pr-interface'." - :type 'boolean - :group 'printing) + :type 'boolean) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3166,15 +2763,6 @@ See `pr-ps-printer-alist'.") See `pr-ps-printer-alist'.") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Macros - - -(defmacro pr-save-file-modes (&rest body) - "Execute BODY with file permissions temporarily set to `pr-file-modes'." - (declare (obsolete with-file-modes "25.1")) - `(with-file-modes pr-file-modes ,@body)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Keys & Menus @@ -3195,252 +2783,211 @@ See `pr-ps-printer-alist'.") (and pr-print-using-ghostscript (not pr-spool-p))) -(defalias 'pr-get-symbol - (if (featurep 'emacs) 'easy-menu-intern ; since 22.1 - (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el - 'easy-menu-intern - (lambda (s) (if (stringp s) (intern s) s))))) - - (defconst pr-menu-spec - ;; Menu mapping: - ;; unfortunately XEmacs doesn't support :active for submenus, - ;; only for items. - ;; So, it uses :included instead of :active. - ;; Also, XEmacs doesn't support :help tag. - (let ((pr-:active (if (featurep 'xemacs) - :included ; XEmacs - :active)) ; GNU Emacs - (pr-:help (if (featurep 'xemacs) - 'ignore ; XEmacs - #'(lambda (text) (list :help text))))) ; GNU Emacs - `( - ["Printing Interface" pr-interface - ,@(funcall - pr-:help "Use buffer interface instead of menu interface")] + '( + ["Printing Interface" pr-interface + :help "Use buffer interface instead of menu interface"] + "--" + ("PostScript Preview" :included (pr-visible-p 'postscript) + :help "Preview PostScript instead of sending to printer" + ("Directory" :active (not pr-spool-p) + ["1-up" (pr-ps-directory-preview 1 nil nil t) t] + ["2-up" (pr-ps-directory-preview 2 nil nil t) t] + ["4-up" (pr-ps-directory-preview 4 nil nil t) t] + ["Other..." (pr-ps-directory-preview nil nil nil t) + :keys "\\[pr-ps-buffer-preview]"]) + ("Buffer" :active (not pr-spool-p) + ["1-up" (pr-ps-buffer-preview 1 t) t] + ["2-up" (pr-ps-buffer-preview 2 t) t] + ["4-up" (pr-ps-buffer-preview 4 t) t] + ["Other..." (pr-ps-buffer-preview nil t) + :keys "\\[pr-ps-buffer-preview]"]) + ("Region" :active (and (not pr-spool-p) (ps-mark-active-p)) + ["1-up" (pr-ps-region-preview 1 t) t] + ["2-up" (pr-ps-region-preview 2 t) t] + ["4-up" (pr-ps-region-preview 4 t) t] + ["Other..." (pr-ps-region-preview nil t) + :keys "\\[pr-ps-region-preview]"]) + ("Mode" :active (and (not pr-spool-p) (pr-mode-alist-p)) + ["1-up" (pr-ps-mode-preview 1 t) t] + ["2-up" (pr-ps-mode-preview 2 t) t] + ["4-up" (pr-ps-mode-preview 4 t) t] + ["Other..." (pr-ps-mode-preview nil t) + :keys "\\[pr-ps-mode-preview]"]) + ("File" + ["No Preprocessing..." (call-interactively 'pr-ps-file-preview) + :keys "\\[pr-ps-file-preview]" + :help "Preview PostScript file"] "--" - ("PostScript Preview" :included (pr-visible-p 'postscript) - ,@(funcall - pr-:help "Preview PostScript instead of sending to printer") - ("Directory" ,pr-:active (not pr-spool-p) - ["1-up" (pr-ps-directory-preview 1 nil nil t) t] - ["2-up" (pr-ps-directory-preview 2 nil nil t) t] - ["4-up" (pr-ps-directory-preview 4 nil nil t) t] - ["Other..." (pr-ps-directory-preview nil nil nil t) - :keys "\\[pr-ps-buffer-preview]"]) - ("Buffer" ,pr-:active (not pr-spool-p) - ["1-up" (pr-ps-buffer-preview 1 t) t] - ["2-up" (pr-ps-buffer-preview 2 t) t] - ["4-up" (pr-ps-buffer-preview 4 t) t] - ["Other..." (pr-ps-buffer-preview nil t) - :keys "\\[pr-ps-buffer-preview]"]) - ("Region" ,pr-:active (and (not pr-spool-p) (ps-mark-active-p)) - ["1-up" (pr-ps-region-preview 1 t) t] - ["2-up" (pr-ps-region-preview 2 t) t] - ["4-up" (pr-ps-region-preview 4 t) t] - ["Other..." (pr-ps-region-preview nil t) - :keys "\\[pr-ps-region-preview]"]) - ("Mode" ,pr-:active (and (not pr-spool-p) (pr-mode-alist-p)) - ["1-up" (pr-ps-mode-preview 1 t) t] - ["2-up" (pr-ps-mode-preview 2 t) t] - ["4-up" (pr-ps-mode-preview 4 t) t] - ["Other..." (pr-ps-mode-preview nil t) - :keys "\\[pr-ps-mode-preview]"]) - ("File" - ["No Preprocessing..." (call-interactively 'pr-ps-file-preview) - :keys "\\[pr-ps-file-preview]" - ,@(funcall - pr-:help "Preview PostScript file")] - "--" - ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist - ,@(funcall - pr-:help "Select PostScript utility")] - "--" - ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist] - ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist] - ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist] - ["Other..." (pr-ps-file-up-preview nil t t) - :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist] - "--" - ["Landscape" pr-toggle-file-landscape-menu - :style toggle :selected pr-file-landscape - ,@(funcall - pr-:help "Toggle landscape for PostScript file") - :active pr-ps-utility-alist] - ["Duplex" pr-toggle-file-duplex-menu - :style toggle :selected pr-file-duplex - ,@(funcall - pr-:help "Toggle duplex for PostScript file") - :active pr-ps-utility-alist] - ["Tumble" pr-toggle-file-tumble-menu - :style toggle :selected pr-file-tumble - ,@(funcall - pr-:help "Toggle tumble for PostScript file") - :active (and pr-file-duplex pr-ps-utility-alist)]) - ["Despool..." (call-interactively 'pr-despool-preview) - :active pr-spool-p :keys "\\[pr-despool-preview]" - ,@(funcall - pr-:help "Despool PostScript buffer to printer or file (C-u)")]) - ("PostScript Print" :included (pr-visible-p 'postscript) - ,@(funcall - pr-:help "Send PostScript to printer or file (C-u)") - ("Directory" - ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t] - ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t] - ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t] - ["Other..." (pr-ps-directory-ps-print nil nil nil t) - :keys "\\[pr-ps-buffer-ps-print]"]) - ("Buffer" - ["1-up" (pr-ps-buffer-ps-print 1 t) t] - ["2-up" (pr-ps-buffer-ps-print 2 t) t] - ["4-up" (pr-ps-buffer-ps-print 4 t) t] - ["Other..." (pr-ps-buffer-ps-print nil t) - :keys "\\[pr-ps-buffer-ps-print]"]) - ("Region" ,pr-:active (ps-mark-active-p) - ["1-up" (pr-ps-region-ps-print 1 t) t] - ["2-up" (pr-ps-region-ps-print 2 t) t] - ["4-up" (pr-ps-region-ps-print 4 t) t] - ["Other..." (pr-ps-region-ps-print nil t) - :keys "\\[pr-ps-region-ps-print]"]) - ("Mode" ,pr-:active (pr-mode-alist-p) - ["1-up" (pr-ps-mode-ps-print 1 t) t] - ["2-up" (pr-ps-mode-ps-print 2 t) t] - ["4-up" (pr-ps-mode-ps-print 4 t) t] - ["Other..." (pr-ps-mode-ps-print nil t) - :keys "\\[pr-ps-mode-ps-print]"]) - ("File" - ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print) - :keys "\\[pr-ps-file-ps-print]" - ,@(funcall - pr-:help "Send PostScript file to printer")] - "--" - ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist - ,@(funcall - pr-:help "Select PostScript utility")] - "--" - ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist] - ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist] - ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist] - ["Other..." (pr-ps-file-up-ps-print nil t t) - :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist] - "--" - ["Landscape" pr-toggle-file-landscape-menu - :style toggle :selected pr-file-landscape - ,@(funcall - pr-:help "Toggle landscape for PostScript file") - :active pr-ps-utility-alist] - ["Duplex" pr-toggle-file-duplex-menu - :style toggle :selected pr-file-duplex - ,@(funcall - pr-:help "Toggle duplex for PostScript file") - :active pr-ps-utility-alist] - ["Tumble" pr-toggle-file-tumble-menu - :style toggle :selected pr-file-tumble - ,@(funcall - pr-:help "Toggle tumble for PostScript file") - :active (and pr-file-duplex pr-ps-utility-alist)]) - ["Despool..." (call-interactively 'pr-despool-ps-print) - :active pr-spool-p :keys "\\[pr-despool-ps-print]" - ,@(funcall - pr-:help "Despool PostScript buffer to printer or file (C-u)")]) - ["PostScript Printers" pr-update-menus - :active pr-ps-printer-alist :included (pr-visible-p 'postscript) - ,@(funcall - pr-:help "Select PostScript printer")] + ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist + :help "Select PostScript utility"] "--" - ("Printify" :included (pr-visible-p 'text) - ,@(funcall - pr-:help - "Replace non-printing chars with printable representations.") - ["Directory" pr-printify-directory t] - ["Buffer" pr-printify-buffer t] - ["Region" pr-printify-region (ps-mark-active-p)]) - ("Print" :included (pr-visible-p 'text) - ,@(funcall - pr-:help "Send text to printer") - ["Directory" pr-txt-directory t] - ["Buffer" pr-txt-buffer t] - ["Region" pr-txt-region (ps-mark-active-p)] - ["Mode" pr-txt-mode (pr-mode-alist-p)]) - ["Text Printers" pr-update-menus - :active pr-txt-printer-alist :included (pr-visible-p 'text) - ,@(funcall - pr-:help "Select text printer")] + ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist] + ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist] + ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist] + ["Other..." (pr-ps-file-up-preview nil t t) + :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist] "--" - ["Landscape" pr-toggle-landscape-menu - :style toggle :selected ps-landscape-mode - :included (pr-visible-p 'postscript-options)] - ["Print Header" pr-toggle-header-menu - :style toggle :selected ps-print-header - :included (pr-visible-p 'postscript-options)] - ["Print Header Frame" pr-toggle-header-frame-menu - :style toggle :selected ps-print-header-frame :active ps-print-header - :included (pr-visible-p 'postscript-options)] - ["Line Number" pr-toggle-line-menu - :style toggle :selected ps-line-number - :included (pr-visible-p 'postscript-options)] - ["Zebra Stripes" pr-toggle-zebra-menu - :style toggle :selected ps-zebra-stripes - :included (pr-visible-p 'postscript-options)] - ["Duplex" pr-toggle-duplex-menu - :style toggle :selected ps-spool-duplex - :included (pr-visible-p 'postscript-options)] - ["Tumble" pr-toggle-tumble-menu - :style toggle :selected ps-spool-tumble :active ps-spool-duplex - :included (pr-visible-p 'postscript-options)] - ["Upside-Down" pr-toggle-upside-down-menu - :style toggle :selected ps-print-upside-down - :included (pr-visible-p 'postscript-options)] - ("Print All Pages" :included (pr-visible-p 'postscript-options) - ,@(funcall - pr-:help "Select odd/even pages/sheets to print") - ["All Pages" (pr-even-or-odd-pages nil) - :style radio :selected (eq ps-even-or-odd-pages nil)] - ["Even Pages" (pr-even-or-odd-pages 'even-page) - :style radio :selected (eq ps-even-or-odd-pages 'even-page)] - ["Odd Pages" (pr-even-or-odd-pages 'odd-page) - :style radio :selected (eq ps-even-or-odd-pages 'odd-page)] - ["Even Sheets" (pr-even-or-odd-pages 'even-sheet) - :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)] - ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet) - :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)]) + ["Landscape" pr-toggle-file-landscape-menu + :style toggle :selected pr-file-landscape + :help "Toggle landscape for PostScript file" + :active pr-ps-utility-alist] + ["Duplex" pr-toggle-file-duplex-menu + :style toggle :selected pr-file-duplex + :help "Toggle duplex for PostScript file" + :active pr-ps-utility-alist] + ["Tumble" pr-toggle-file-tumble-menu + :style toggle :selected pr-file-tumble + :help "Toggle tumble for PostScript file" + :active (and pr-file-duplex pr-ps-utility-alist)]) + ["Despool..." (call-interactively 'pr-despool-preview) + :active pr-spool-p :keys "\\[pr-despool-preview]" + :help "Despool PostScript buffer to printer or file (C-u)"]) + ("PostScript Print" :included (pr-visible-p 'postscript) + :help "Send PostScript to printer or file (C-u)" + ("Directory" + ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t] + ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t] + ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t] + ["Other..." (pr-ps-directory-ps-print nil nil nil t) + :keys "\\[pr-ps-buffer-ps-print]"]) + ("Buffer" + ["1-up" (pr-ps-buffer-ps-print 1 t) t] + ["2-up" (pr-ps-buffer-ps-print 2 t) t] + ["4-up" (pr-ps-buffer-ps-print 4 t) t] + ["Other..." (pr-ps-buffer-ps-print nil t) + :keys "\\[pr-ps-buffer-ps-print]"]) + ("Region" :active (ps-mark-active-p) + ["1-up" (pr-ps-region-ps-print 1 t) t] + ["2-up" (pr-ps-region-ps-print 2 t) t] + ["4-up" (pr-ps-region-ps-print 4 t) t] + ["Other..." (pr-ps-region-ps-print nil t) + :keys "\\[pr-ps-region-ps-print]"]) + ("Mode" :active (pr-mode-alist-p) + ["1-up" (pr-ps-mode-ps-print 1 t) t] + ["2-up" (pr-ps-mode-ps-print 2 t) t] + ["4-up" (pr-ps-mode-ps-print 4 t) t] + ["Other..." (pr-ps-mode-ps-print nil t) + :keys "\\[pr-ps-mode-ps-print]"]) + ("File" + ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print) + :keys "\\[pr-ps-file-ps-print]" + :help "Send PostScript file to printer"] "--" - ["Spool Buffer" pr-toggle-spool-menu - :style toggle :selected pr-spool-p - :included (pr-visible-p 'postscript-process) - ,@(funcall - pr-:help "Toggle PostScript spooling")] - ["Print with faces" pr-toggle-faces-menu - :style toggle :selected pr-faces-p - :included (pr-visible-p 'postscript-process) - ,@(funcall - pr-:help "Toggle PostScript printing with faces")] - ["Print via Ghostscript" pr-toggle-ghostscript-menu - :style toggle :selected pr-print-using-ghostscript - :included (pr-visible-p 'postscript-process) - ,@(funcall - pr-:help "Toggle PostScript generation using ghostscript")] + ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist + :help "Select PostScript utility"] "--" - ["Auto Region" pr-toggle-region-menu - :style toggle :selected pr-auto-region - :included (pr-visible-p 'printing)] - ["Auto Mode" pr-toggle-mode-menu - :style toggle :selected pr-auto-mode - :included (pr-visible-p 'printing)] - ["Menu Lock" pr-toggle-lock-menu - :style toggle :selected pr-menu-lock - :included (pr-visible-p 'printing)] + ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist] + ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist] + ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist] + ["Other..." (pr-ps-file-up-ps-print nil t t) + :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist] "--" - ("Customize" :included (pr-visible-p 'help) - ["printing" pr-customize t] - ["ps-print" ps-print-customize t] - ["lpr" lpr-customize t]) - ("Show Settings" :included (pr-visible-p 'help) - ["printing" pr-show-pr-setup t] - ["ps-print" pr-show-ps-setup t] - ["lpr" pr-show-lpr-setup t]) - ["Help" pr-help :active t :included (pr-visible-p 'help)] - ))) + ["Landscape" pr-toggle-file-landscape-menu + :style toggle :selected pr-file-landscape + :help "Toggle landscape for PostScript file" + :active pr-ps-utility-alist] + ["Duplex" pr-toggle-file-duplex-menu + :style toggle :selected pr-file-duplex + :help "Toggle duplex for PostScript file" + :active pr-ps-utility-alist] + ["Tumble" pr-toggle-file-tumble-menu + :style toggle :selected pr-file-tumble + :help "Toggle tumble for PostScript file" + :active (and pr-file-duplex pr-ps-utility-alist)]) + ["Despool..." (call-interactively 'pr-despool-ps-print) + :active pr-spool-p :keys "\\[pr-despool-ps-print]" + :help "Despool PostScript buffer to printer or file (C-u)"]) + ["PostScript Printers" pr-update-menus + :active pr-ps-printer-alist :included (pr-visible-p 'postscript) + :help "Select PostScript printer"] + "--" + ("Printify" :included (pr-visible-p 'text) + :help + "Replace non-printing chars with printable representations." + ["Directory" pr-printify-directory t] + ["Buffer" pr-printify-buffer t] + ["Region" pr-printify-region (ps-mark-active-p)]) + ("Print" :included (pr-visible-p 'text) + :help "Send text to printer" + ["Directory" pr-txt-directory t] + ["Buffer" pr-txt-buffer t] + ["Region" pr-txt-region (ps-mark-active-p)] + ["Mode" pr-txt-mode (pr-mode-alist-p)]) + ["Text Printers" pr-update-menus + :active pr-txt-printer-alist :included (pr-visible-p 'text) + :help "Select text printer"] + "--" + ["Landscape" pr-toggle-landscape-menu + :style toggle :selected ps-landscape-mode + :included (pr-visible-p 'postscript-options)] + ["Print Header" pr-toggle-header-menu + :style toggle :selected ps-print-header + :included (pr-visible-p 'postscript-options)] + ["Print Header Frame" pr-toggle-header-frame-menu + :style toggle :selected ps-print-header-frame :active ps-print-header + :included (pr-visible-p 'postscript-options)] + ["Line Number" pr-toggle-line-menu + :style toggle :selected ps-line-number + :included (pr-visible-p 'postscript-options)] + ["Zebra Stripes" pr-toggle-zebra-menu + :style toggle :selected ps-zebra-stripes + :included (pr-visible-p 'postscript-options)] + ["Duplex" pr-toggle-duplex-menu + :style toggle :selected ps-spool-duplex + :included (pr-visible-p 'postscript-options)] + ["Tumble" pr-toggle-tumble-menu + :style toggle :selected ps-spool-tumble :active ps-spool-duplex + :included (pr-visible-p 'postscript-options)] + ["Upside-Down" pr-toggle-upside-down-menu + :style toggle :selected ps-print-upside-down + :included (pr-visible-p 'postscript-options)] + ("Print All Pages" :included (pr-visible-p 'postscript-options) + :help "Select odd/even pages/sheets to print" + ["All Pages" (pr-even-or-odd-pages nil) + :style radio :selected (eq ps-even-or-odd-pages nil)] + ["Even Pages" (pr-even-or-odd-pages 'even-page) + :style radio :selected (eq ps-even-or-odd-pages 'even-page)] + ["Odd Pages" (pr-even-or-odd-pages 'odd-page) + :style radio :selected (eq ps-even-or-odd-pages 'odd-page)] + ["Even Sheets" (pr-even-or-odd-pages 'even-sheet) + :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)] + ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet) + :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)]) + "--" + ["Spool Buffer" pr-toggle-spool-menu + :style toggle :selected pr-spool-p + :included (pr-visible-p 'postscript-process) + :help "Toggle PostScript spooling"] + ["Print with faces" pr-toggle-faces-menu + :style toggle :selected pr-faces-p + :included (pr-visible-p 'postscript-process) + :help "Toggle PostScript printing with faces"] + ["Print via Ghostscript" pr-toggle-ghostscript-menu + :style toggle :selected pr-print-using-ghostscript + :included (pr-visible-p 'postscript-process) + :help "Toggle PostScript generation using ghostscript"] + "--" + ["Auto Region" pr-toggle-region-menu + :style toggle :selected pr-auto-region + :included (pr-visible-p 'printing)] + ["Auto Mode" pr-toggle-mode-menu + :style toggle :selected pr-auto-mode + :included (pr-visible-p 'printing)] + ["Menu Lock" pr-toggle-lock-menu + :style toggle :selected pr-menu-lock + :included (pr-visible-p 'printing)] + "--" + ("Customize" :included (pr-visible-p 'help) + ["printing" pr-customize t] + ["ps-print" ps-print-customize t] + ["lpr" lpr-customize t]) + ("Show Settings" :included (pr-visible-p 'help) + ["printing" pr-show-pr-setup t] + ["ps-print" pr-show-ps-setup t] + ["lpr" pr-show-lpr-setup t]) + ["Help" pr-help :active t :included (pr-visible-p 'help)] + )) (defun pr-menu-bind () @@ -3453,19 +3000,17 @@ Calls `pr-update-menus' to adjust menus." ;; Key binding -(let ((pr-print-key (if (featurep 'xemacs) - 'f22 ; XEmacs - 'print))) ; GNU Emacs - (global-set-key `[,pr-print-key] 'pr-ps-fast-fire) - ;; Well, M-print and S-print are used because in my keyboard S-print works - ;; and M-print doesn't. But M-print can work in other keyboard. - (global-set-key `[(meta ,pr-print-key)] 'pr-ps-mode-using-ghostscript) - (global-set-key `[(shift ,pr-print-key)] 'pr-ps-mode-using-ghostscript) - ;; Well, C-print and C-M-print are used because in my keyboard C-M-print works - ;; and C-print doesn't. But C-print can work in other keyboard. - (global-set-key `[(control ,pr-print-key)] 'pr-txt-fast-fire) - (global-set-key `[(control meta ,pr-print-key)] 'pr-txt-fast-fire)) - +;; FIXME: These should be moved to a function so that just loading the file +;; doesn't affect the global keymap! +(global-set-key [print] 'pr-ps-fast-fire) +;; Well, M-print and S-print are used because on my keyboard S-print works +;; and M-print doesn't. But M-print can work on other keyboards. +(global-set-key [(meta print)] 'pr-ps-mode-using-ghostscript) +(global-set-key [(shift print)] 'pr-ps-mode-using-ghostscript) +;; Well, C-print and C-M-print are used because in my keyboard C-M-print works +;; and C-print doesn't. But C-print can work in other keyboard. +(global-set-key [(control print)] 'pr-txt-fast-fire) +(global-set-key [(control meta print)] 'pr-txt-fast-fire) ;;; You can also use something like: ;;;(global-set-key "\C-ci" 'pr-interface) @@ -3962,13 +3507,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt "PS preview dir"))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt "PS preview dir")) - (setq filename (pr-ps-file filename)) - (pr-ps-file-list n-up dir file-regexp filename) - (or pr-spool-p - (pr-ps-file-preview filename))) - + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt "PS preview dir")) + (setq pr--filename (pr-ps-file pr--filename)) + (pr-ps-file-list pr--n-up pr--dir pr--file-regexp pr--filename) + (or pr-spool-p + (pr-ps-file-preview pr--filename)))) ;;;###autoload (defun pr-ps-directory-using-ghostscript (n-up dir file-regexp &optional filename) @@ -3988,12 +3536,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir GS"))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt "PS print dir GS")) - (let ((file (pr-ps-file filename))) - (pr-ps-file-list n-up dir file-regexp file) - (pr-ps-file-using-ghostscript file) - (or filename (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt "PS print dir GS")) + (let ((file (pr-ps-file pr--filename))) + (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file) + (pr-ps-file-using-ghostscript file) + (or pr--filename (pr-delete-file file))))) ;;;###autoload @@ -4014,12 +3566,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir"))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt "PS print dir")) - (let ((file (pr-ps-file filename))) - (pr-ps-file-list n-up dir file-regexp file) - (pr-ps-file-print file) - (or filename (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt "PS print dir")) + (let ((file (pr-ps-file pr--filename))) + (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file) + (pr-ps-file-print file) + (or pr--filename (pr-delete-file file))))) ;;;###autoload @@ -4043,11 +3599,16 @@ file name. See also documentation for `pr-list-directory'." (interactive (pr-interactive-ps-dir-args (pr-prompt (pr-prompt-gs "PS print dir")))) - (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename - (pr-prompt (pr-prompt-gs "PS print dir"))) - (if (pr-using-ghostscript-p) - (pr-ps-directory-using-ghostscript n-up dir file-regexp filename) - (pr-ps-directory-print n-up dir file-regexp filename))) + (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp) + (defvar pr--filename) + (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp) + (pr--filename filename)) + (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename + (pr-prompt (pr-prompt-gs "PS print dir"))) + (funcall (if (pr-using-ghostscript-p) + #'pr-ps-directory-using-ghostscript + #'pr-ps-directory-print) + pr--n-up pr--dir pr--file-regexp pr--filename))) ;;;###autoload @@ -4191,11 +3752,13 @@ See also `pr-ps-buffer-ps-print'." See also `pr-ps-buffer-preview'." (interactive (pr-interactive-n-up-file "PS preview mode")) - (pr-set-n-up-and-filename 'n-up 'filename "PS preview mode") - (let ((file (pr-ps-file filename))) - (and (pr-ps-mode n-up file) - (not pr-spool-p) - (pr-ps-file-preview file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS preview mode") + (let ((file (pr-ps-file pr--filename))) + (and (pr-ps-mode pr--n-up file) + (not pr-spool-p) + (pr-ps-file-preview file))))) ;;;###autoload @@ -4204,12 +3767,14 @@ See also `pr-ps-buffer-preview'." See also `pr-ps-buffer-using-ghostscript'." (interactive (pr-interactive-n-up-file "PS print GS mode")) - (pr-set-n-up-and-filename 'n-up 'filename "PS print GS mode") - (let ((file (pr-ps-file filename))) - (when (and (pr-ps-mode n-up file) - (not pr-spool-p)) - (pr-ps-file-using-ghostscript file) - (or filename (pr-delete-file file))))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print GS mode") + (let ((file (pr-ps-file pr--filename))) + (when (and (pr-ps-mode pr--n-up file) + (not pr-spool-p)) + (pr-ps-file-using-ghostscript file) + (or pr--filename (pr-delete-file file)))))) ;;;###autoload @@ -4218,8 +3783,10 @@ See also `pr-ps-buffer-using-ghostscript'." See also `pr-ps-buffer-print'." (interactive (pr-interactive-n-up-file "PS print mode")) - (pr-set-n-up-and-filename 'n-up 'filename "PS print mode") - (pr-ps-mode n-up filename)) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print mode") + (pr-ps-mode pr--n-up pr--filename))) ;;;###autoload @@ -4247,8 +3814,10 @@ prompts for FILE(name)-REGEXP. See also documentation for `pr-list-directory'." (interactive (pr-interactive-dir-args "Printify dir")) - (pr-set-dir-args 'dir 'file-regexp "Printify dir") - (pr-file-list dir file-regexp 'pr-printify-buffer)) + (defvar pr--dir) (defvar pr--file-regexp) + (let ((pr--dir dir) (pr--file-regexp file-regexp)) + (pr-set-dir-args 'pr--dir 'pr--file-regexp "Printify dir") + (pr-file-list pr--dir pr--file-regexp 'pr-printify-buffer))) ;;;###autoload @@ -4283,8 +3852,10 @@ prompts for FILE(name)-REGEXP. See also documentation for `pr-list-directory'." (interactive (pr-interactive-dir-args "Print dir")) - (pr-set-dir-args 'dir 'file-regexp "Print dir") - (pr-file-list dir file-regexp 'pr-txt-buffer)) + (defvar pr--dir) (defvar pr--file-regexp) + (let ((pr--dir dir) (pr--file-regexp file-regexp)) + (pr-set-dir-args 'pr--dir 'pr--file-regexp "Print dir") + (pr-file-list pr--dir pr--file-regexp 'pr-txt-buffer))) ;;;###autoload @@ -4406,10 +3977,12 @@ image in a file with that name." (defun pr-ps-file-up-preview (n-up ifilename &optional ofilename) "Preview PostScript file FILENAME." (interactive (pr-interactive-n-up-inout "PS preview")) - (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename - "PS preview "))) - (pr-ps-utility-process n-up ifilename outfile) - (pr-ps-file-preview outfile))) + (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename) + (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename)) + (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename + "PS preview "))) + (pr-ps-utility-process pr--n-up pr--ifilename outfile) + (pr-ps-file-preview outfile)))) ;;;###autoload @@ -4417,15 +3990,18 @@ image in a file with that name." "Print PostScript file FILENAME using ghostscript." (interactive (list (pr-ps-infile-preprint "Print preview "))) (and (stringp filename) (file-exists-p filename) - (let* ((file (pr-expand-file-name filename)) - (tempfile (pr-dosify-file-name (make-temp-file file)))) + (let* ((file (expand-file-name filename)) + (tempfile (make-temp-file file))) ;; gs use (pr-call-process pr-gs-command (format "-sDEVICE=%s" pr-gs-device) (format "-r%d" pr-gs-resolution) (pr-switches-string pr-gs-switches "pr-gs-switches") - (format "-sOutputFile=\"%s\"" tempfile) - file + (format "-sOutputFile=\"%s\"" + ;; FIXME: Do we need to dosify here really? + (pr-dosify-file-name tempfile)) + ;; FIXME: Do we need to dosify here really? + (pr-dosify-file-name file) "-c quit") ;; printing (pr-ps-file-print tempfile) @@ -4439,7 +4015,7 @@ image in a file with that name." (interactive (list (pr-ps-infile-preprint "Print "))) (and (stringp filename) (file-exists-p filename) ;; printing - (let ((file (pr-expand-file-name filename))) + (let ((file (expand-file-name filename))) (if (string= pr-ps-command "") ;; default action (let ((ps-spool-buffer (get-buffer-create ps-spool-buffer-name))) @@ -4448,16 +4024,16 @@ image in a file with that name." (insert-file-contents-literally file)) (pr-despool-print)) ;; use `pr-ps-command' to print - (apply 'pr-call-process + (apply #'pr-call-process pr-ps-command (pr-switches-string pr-ps-switches "pr-ps-switches") (if (string-match "cp" pr-ps-command) ;; for "cp" (cmd in out) - (list file + (list (pr-dosify-file-name file) (concat pr-ps-printer-switch pr-ps-printer)) ;; else, for others (cmd out in) (list (concat pr-ps-printer-switch pr-ps-printer) - file))))))) + (pr-dosify-file-name file)))))))) ;;;###autoload @@ -4492,14 +4068,16 @@ file name." (if pr-print-using-ghostscript "PS print GS" "PS print"))) - (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename - (if pr-print-using-ghostscript - "PS print GS " - "PS print ")))) - (pr-ps-utility-process n-up ifilename outfile) - (unless ofilename - (pr-ps-file-ps-print outfile) - (pr-delete-file outfile)))) + (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename) + (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename)) + (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename + (if pr-print-using-ghostscript + "PS print GS " + "PS print ")))) + (pr-ps-utility-process pr--n-up pr--ifilename outfile) + (unless pr--ofilename + (pr-ps-file-ps-print outfile) + (pr-delete-file outfile))))) ;;;###autoload @@ -5210,9 +4788,9 @@ If menu binding was not done, calls `pr-menu-bind'." (let ((sym (car elt))) (vector (symbol-name sym) - (list fun (list 'quote sym) nil (list 'quote entry) index) + `(,fun ',sym nil ',entry ',index) :style 'radio - :selected (list 'eq var-sym (list 'quote sym))))) + :selected `(eq ,var-sym ',sym)))) alist))) @@ -5224,7 +4802,7 @@ If menu binding was not done, calls `pr-menu-bind'." value)) (setq pr-ps-utility value) (pr-eval-alist (nthcdr 9 item))) - (pr-update-mode-line)) + (force-mode-line-update)) (defun pr-ps-set-printer (value) @@ -5234,7 +4812,7 @@ If menu binding was not done, calls `pr-menu-bind'." "Invalid PostScript printer name `%s' for variable `pr-ps-name'" value)) (setq pr-ps-name value - pr-ps-command (pr-dosify-file-name (nth 0 ps)) + pr-ps-command (nth 0 ps) pr-ps-switches (nth 1 ps) pr-ps-printer-switch (nth 2 ps) pr-ps-printer (nth 3 ps)) @@ -5251,7 +4829,7 @@ If menu binding was not done, calls `pr-menu-bind'." (t "-P") ))) (pr-eval-alist (nthcdr 4 ps))) - (pr-update-mode-line)) + (force-mode-line-update)) (defun pr-txt-set-printer (value) @@ -5260,7 +4838,7 @@ If menu binding was not done, calls `pr-menu-bind'." (error "Invalid text printer name `%s' for variable `pr-txt-name'" value)) (setq pr-txt-name value - pr-txt-command (pr-dosify-file-name (nth 0 txt)) + pr-txt-command (nth 0 txt) pr-txt-switches (nth 1 txt) pr-txt-printer (nth 2 txt))) (or (stringp pr-txt-command) @@ -5269,30 +4847,28 @@ If menu binding was not done, calls `pr-menu-bind'." (lpr-lp-system "lp") (t "lpr") ))) - (pr-update-mode-line)) + (force-mode-line-update)) (defun pr-eval-alist (alist) - (mapcar #'(lambda (option) - (let ((var-sym (car option)) - (value (cdr option))) - (if (eq var-sym 'inherits-from:) - (pr-eval-setting-alist value 'global) - (set var-sym (eval value))))) - alist)) + (dolist (option alist) + (let ((var-sym (car option)) + (value (cdr option))) + (if (eq var-sym 'inherits-from:) + (pr-eval-setting-alist value 'global) + (set var-sym (eval value)))))) (defun pr-eval-local-alist (alist) (let (local-list) - (mapc #'(lambda (option) - (let ((var-sym (car option)) - (value (cdr option))) - (setq local-list - (if (eq var-sym 'inherits-from:) - (nconc (pr-eval-setting-alist value) local-list) - (set (make-local-variable var-sym) (eval value)) - (cons var-sym local-list))))) - alist) + (dolist (option alist) + (let ((var-sym (car option)) + (value (cdr option))) + (setq local-list + (if (eq var-sym 'inherits-from:) + (nconc (pr-eval-setting-alist value) local-list) + (set (make-local-variable var-sym) (eval value)) + (cons var-sym local-list))))) local-list)) @@ -5338,7 +4914,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-kill-local-variable (local-var-list) - (mapcar 'kill-local-variable local-var-list)) + (mapcar #'kill-local-variable local-var-list)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5526,10 +5102,6 @@ If menu binding was not done, calls `pr-menu-bind'." (delete-file file))) -(defun pr-expand-file-name (filename) - (pr-dosify-file-name (expand-file-name filename))) - - (defun pr-ps-outfile-preprint (&optional mess) (let* ((prompt (format "%soutput PostScript file name: " (or mess ""))) (res (read-file-name prompt default-directory "" nil))) @@ -5549,7 +5121,7 @@ If menu binding was not done, calls `pr-menu-bind'." (format "File %s; PostScript file: " prompt) (file-name-directory res) nil nil (file-name-nondirectory res)))) - (pr-expand-file-name res))) + (expand-file-name res))) (defun pr-ps-infile-preprint (&optional mess) @@ -5569,7 +5141,7 @@ If menu binding was not done, calls `pr-menu-bind'." (format "File %s; PostScript file: " prompt) (file-name-directory res) nil nil (file-name-nondirectory res)))) - (pr-expand-file-name res))) + (expand-file-name res))) (defun pr-ps-utility-args (n-up-sym infile-sym outfile-sym prompt) @@ -5582,13 +5154,10 @@ If menu binding was not done, calls `pr-menu-bind'." (set infile-sym (pr-ps-infile-preprint prompt))) (or (symbol-value infile-sym) (error "%s: input PostScript file name is missing" prompt)) - (set infile-sym (pr-dosify-file-name (symbol-value infile-sym))) ;; output file (and (eq (symbol-value outfile-sym) t) (set outfile-sym (and current-prefix-arg (pr-ps-outfile-preprint prompt)))) - (and (symbol-value outfile-sym) - (set outfile-sym (pr-dosify-file-name (symbol-value outfile-sym)))) (pr-ps-file (symbol-value outfile-sym))) @@ -5608,9 +5177,9 @@ If menu binding was not done, calls `pr-menu-bind'." (and pr-file-landscape (nth 4 item)) (and pr-file-duplex (nth 5 item)) (and pr-file-tumble (nth 6 item)) - (pr-expand-file-name infile) + (pr-dosify-file-name (expand-file-name infile)) (nth 7 item) - (pr-expand-file-name outfile))))) + (pr-dosify-file-name (expand-file-name outfile)))))) (defun pr-remove-nil-from-list (lst) @@ -5640,7 +5209,7 @@ If menu binding was not done, calls `pr-menu-bind'." (with-file-modes pr-file-modes (setq status (condition-case data - (apply 'call-process cmd nil buffer nil args) + (apply #'call-process cmd nil buffer nil args) ((quit error) (error-message-string data))))) ;; *Printing Command Output* == show exit status @@ -5666,7 +5235,7 @@ If menu binding was not done, calls `pr-menu-bind'." ;; If SWITCHES is nil, return nil. ;; Otherwise, return the list of string in a string. (and switches - (mapconcat 'identity (pr-switches switches mess) " "))) + (mapconcat #'identity (pr-switches switches mess) " "))) (defun pr-switches (switches mess) @@ -5677,36 +5246,42 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-ps-preview (kind n-up filename mess) - (pr-set-n-up-and-filename 'n-up 'filename mess) - (let ((file (pr-ps-file filename))) - (pr-text2ps kind n-up file) - (or pr-spool-p (pr-ps-file-preview file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess) + (let ((file (pr-ps-file pr--filename))) + (pr-text2ps kind pr--n-up file) + (or pr-spool-p (pr-ps-file-preview file))))) (defun pr-ps-using-ghostscript (kind n-up filename mess) - (pr-set-n-up-and-filename 'n-up 'filename mess) - (let ((file (pr-ps-file filename))) - (pr-text2ps kind n-up file) - (unless (or pr-spool-p filename) - (pr-ps-file-using-ghostscript file) - (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess) + (let ((file (pr-ps-file pr--filename))) + (pr-text2ps kind pr--n-up file) + (unless (or pr-spool-p pr--filename) + (pr-ps-file-using-ghostscript file) + (pr-delete-file file))))) (defun pr-ps-print (kind n-up filename mess) - (pr-set-n-up-and-filename 'n-up 'filename mess) - (let ((file (pr-ps-file filename))) - (pr-text2ps kind n-up file) - (unless (or pr-spool-p filename) - (pr-ps-file-print file) - (pr-delete-file file)))) + (defvar pr--n-up) (defvar pr--filename) + (let ((pr--n-up n-up) (pr--filename filename)) + (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess) + (let ((file (pr-ps-file pr--filename))) + (pr-text2ps kind pr--n-up file) + (unless (or pr-spool-p pr--filename) + (pr-ps-file-print file) + (pr-delete-file file))))) (defun pr-ps-file (&optional filename) - (pr-dosify-file-name (or filename - (make-temp-file - (convert-standard-filename - (expand-file-name pr-ps-temp-file pr-temp-dir)) - nil ".ps")))) + (or filename + (make-temp-file + (convert-standard-filename + (expand-file-name pr-ps-temp-file pr-temp-dir)) + nil ".ps"))) (defun pr-interactive-n-up (mess) @@ -5714,7 +5289,7 @@ If menu binding was not done, calls `pr-menu-bind'." (save-match-data (let* ((fmt-prompt "%s[%s] N-up printing (default 1): ") (prompt "") - (str (pr-read-string (format fmt-prompt prompt mess) "1" nil "1")) + (str (read-string (format fmt-prompt prompt mess) nil nil "1")) int) (while (if (string-match "^\\s *[0-9]+$" str) (setq int (string-to-number str) @@ -5724,7 +5299,7 @@ If menu binding was not done, calls `pr-menu-bind'." (setq prompt "Invalid integer syntax; ")) (ding) (setq str - (pr-read-string (format fmt-prompt prompt mess) str nil "1"))) + (read-string (format fmt-prompt prompt mess) str nil "1"))) int))) @@ -5749,7 +5324,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-interactive-regexp (mess) - (pr-read-string (format "[%s] File regexp to print: " mess) "" nil "")) + (read-string (format "[%s] File regexp to print: " mess) nil nil "")) (defun pr-interactive-dir-args (mess) @@ -5796,9 +5371,7 @@ If menu binding was not done, calls `pr-menu-bind'." (and (not pr-spool-p) (eq (symbol-value filename-sym) t) (set filename-sym (and current-prefix-arg - (ps-print-preprint current-prefix-arg)))) - (and (symbol-value filename-sym) - (set filename-sym (pr-dosify-file-name (symbol-value filename-sym))))) + (ps-print-preprint current-prefix-arg))))) (defun pr-set-n-up-and-filename (n-up-sym filename-sym mess) @@ -5875,7 +5448,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-ps-file-list (n-up dir file-regexp filename) - (pr-delete-file-if-exists (setq filename (pr-expand-file-name filename))) + (pr-delete-file-if-exists (setq filename (expand-file-name filename))) (let ((pr-spool-p t)) (pr-file-list dir file-regexp #'(lambda () @@ -5941,15 +5514,14 @@ If Emacs is running on Windows 95/98/NT/2000, tries to find COMMAND, COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (if (string= command "") command - (pr-dosify-file-name - (or (pr-find-command command) - (pr-path-command (cond (pr-cygwin-system 'cygwin) - (lpr-windows-system 'windows) - (t 'unix)) - (file-name-nondirectory command) - nil) - (error "Command not found: %s" - (file-name-nondirectory command)))))) + (or (pr-find-command command) + (pr-path-command (cond (pr-cygwin-system 'cygwin) + (lpr-windows-system 'windows) + (t 'unix)) + (file-name-nondirectory command) + nil) + (error "Command not found: %s" + (file-name-nondirectory command))))) (defun pr-path-command (symbol command sym-list) @@ -6004,12 +5576,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." ;; Printing Interface (inspired by ps-print-interface.el) -(eval-when-compile - (require 'cus-edit) - (require 'wid-edit) - (require 'widget)) - - (defvar pr-i-window-configuration nil) (defvar pr-i-buffer nil) @@ -6027,20 +5593,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defvar pr-i-ps-send 'printer) -(defvar pr-interface-map nil - "Keymap for pr-interface.") - -(unless pr-interface-map +(defvar pr-interface-map (let ((map (make-sparse-keymap))) - (cond ((featurep 'xemacs) ; XEmacs - (pr-set-keymap-parents map (list widget-keymap)) - (pr-set-keymap-name map 'pr-interface-map)) - (t ; GNU Emacs - (pr-set-keymap-parents map widget-keymap))) + (set-keymap-parent map widget-keymap) (define-key map "q" 'pr-interface-quit) (define-key map "?" 'pr-interface-help) - (setq pr-interface-map map))) - + map) + "Keymap for pr-interface.") (defmacro pr-interface-save (&rest body) `(with-current-buffer pr-i-buffer @@ -6111,15 +5670,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (setq found (string-match (car ignore) name) ignore (cdr ignore))) (or found - (setq choices - (cons (list 'quote - (list 'choice-item - :format "%[%t%]" - name)) - choices))))) + (push (list 'choice-item + :format "%[%t%]" + name) + choices)))) (nreverse choices)) " Buffer : " nil - '(progn + (lambda () (pr-interface-save (setq pr-i-region (ps-mark-active-p) pr-i-mode (pr-mode-alist-p))) @@ -6345,11 +5902,10 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-insert-italic "\n\nSelect Pages : " 2 14) (pr-insert-menu "Page Parity" 'ps-even-or-odd-pages (mapcar #'(lambda (alist) - (list 'quote - (list 'choice-item - :format "%[%t%]" - :tag (cdr alist) - :value (car alist)))) + (list 'choice-item + :format "%[%t%]" + :tag (cdr alist) + :value (car alist))) pr-even-or-odd-alist))) @@ -6605,8 +6161,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-insert-toggle (var-sym label) (widget-create 'checkbox - :notify `(lambda (&rest _ignore) - (setq ,var-sym (not ,var-sym))) + :notify (lambda (&rest _ignore) + (set var-sym (not (symbol-value var-sym)))) (symbol-value var-sym)) (widget-insert label)) @@ -6619,32 +6175,32 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (widget-insert separator))) -(defun pr-insert-menu (tag var-sym choices &optional before after &rest body) +(defun pr-insert-menu (tag var-sym choices &optional before after body) (and before (widget-insert before)) - (eval `(widget-create 'menu-choice - :tag ,tag - :format "%v" - :inline t - :value ,var-sym - :notify (lambda (widget &rest _ignore) - (setq ,var-sym (widget-value widget)) - ,@body) - :void '(choice-item :format "%[%t%]" - :tag "Can not display value!") - ,@choices)) - (and after (widget-insert after))) + (apply #'widget-create 'menu-choice + :tag tag + :format "%v" + :inline t + :value (symbol-value var-sym) + :notify (lambda (widget &rest _ignore) + (set var-sym (widget-value widget)) + (when body (funcall body))) + :void '(choice-item :format "%[%t%]" + :tag "Can not display value!") + choices) + (and after (widget-insert after))) (defun pr-insert-radio-button (var-sym sym) (widget-insert "\n") (let ((wid-list (get var-sym 'pr-widget-list)) - (wid (eval `(widget-create - 'radio-button - :format " %[%v%]" - :value (eq ,var-sym (quote ,sym)) - :notify (lambda (&rest _ignore) - (setq ,var-sym (quote ,sym)) - (pr-update-radio-button (quote ,var-sym))))))) + (wid (widget-create + 'radio-button + :format " %[%v%]" + :value (eq (symbol-value var-sym) sym) + :notify (lambda (&rest _ignore) + (set var-sym sym) + (pr-update-radio-button var-sym))))) (put var-sym 'pr-widget-list (cons (cons wid sym) wid-list)))) @@ -6666,20 +6222,18 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-choice-alist (alist) - (let ((max (apply 'max (mapcar #'(lambda (alist) - (length (symbol-name (car alist)))) - alist)))) + (let ((max (apply #'max (mapcar #'(lambda (alist) + (length (symbol-name (car alist)))) + alist)))) (mapcar #'(lambda (alist) (let* ((sym (car alist)) (name (symbol-name sym))) - (list - 'quote - (list - 'choice-item - :format "%[%t%]" - :tag (concat name - (make-string (- max (length name)) ?_)) - :value sym)))) + (list + 'choice-item + :format "%[%t%]" + :tag (concat name + (make-string (- max (length name)) ?_)) + :value sym))) alist))) From 6cb49922e63c2523ccdd6e0a6bd72bcfa72c50c6 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 25 Mar 2019 02:15:10 +0000 Subject: [PATCH 102/121] Fix Gnus duplicate suppression guards (bug#34987) * lisp/gnus/gnus-dup.el (gnus-dup-enter-articles) (gnus-dup-suppress-articles): Use gnus-dup-hashtb as an indicator of initialization instead of gnus-dup-list, which may happen to be nil. (gnus-dup-unsuppress-article): Do nothing if gnus-dup-hashtb is uninitialized. --- lisp/gnus/gnus-dup.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el index 49022124e97..4981614a17f 100644 --- a/lisp/gnus/gnus-dup.el +++ b/lisp/gnus/gnus-dup.el @@ -107,7 +107,7 @@ seen in the same session." (defun gnus-dup-enter-articles () "Enter articles from the current group for future duplicate suppression." - (unless gnus-dup-list + (unless gnus-dup-hashtb (gnus-dup-open)) (setq gnus-dup-list-dirty t) ; mark list for saving (let (msgid) @@ -133,7 +133,7 @@ seen in the same session." (defun gnus-dup-suppress-articles () "Mark duplicate articles as read." - (unless gnus-dup-list + (unless gnus-dup-hashtb (gnus-dup-open)) (gnus-message 8 "Suppressing duplicates...") (let ((auto (and gnus-newsgroup-auto-expire @@ -152,9 +152,10 @@ seen in the same session." (defun gnus-dup-unsuppress-article (article) "Stop suppression of ARTICLE." - (let* ((header (gnus-data-header (gnus-data-find article))) - (id (when header (mail-header-id header)))) - (when id + (let (header id) + (when (and gnus-dup-hashtb + (setq header (gnus-data-header (gnus-data-find article))) + (setq id (mail-header-id header))) (setq gnus-dup-list-dirty t) (setq gnus-dup-list (delete id gnus-dup-list)) (remhash id gnus-dup-hashtb)))) From d96b672f2b738bb6364023c2dcb9111efd3855ed Mon Sep 17 00:00:00 2001 From: Alex Branham Date: Tue, 9 Apr 2019 16:27:50 -0500 Subject: [PATCH 103/121] Use lexical-binding in bug-reference.el * .dir-locals.el: Set bug-reference-url-format in all modes, not just changelog mode. Use (eval . (bug-reference-mode)) as described in (info "(emacs) Specifying File Variables") * lisp/progmodes/bug-reference.el: Use lexical binding. (bug-reference-unfontify): (bug-reference-fontify): Mention args in docstring. Bug#35123 --- .dir-locals.el | 6 +++--- lisp/progmodes/bug-reference.el | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index 9cd39920c23..ffd65c88027 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,6 +1,7 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 70))) + (fill-column . 70) + (bug-reference-url-format . "https://debbugs.gnu.org/%s"))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) (electric-quote-comment . nil) @@ -12,8 +13,7 @@ (log-edit-setup-add-author . t))) (change-log-mode . ((add-log-time-zone-rule . t) (fill-column . 74) - (bug-reference-url-format . "https://debbugs.gnu.org/%s") - (mode . bug-reference))) + (eval . (bug-reference-mode)))) (diff-mode . ((mode . whitespace))) (emacs-lisp-mode . ((indent-tabs-mode . nil) (electric-quote-comment . nil) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 759db1f5686..813ecbe3847 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -1,4 +1,4 @@ -;; bug-reference.el --- buttonize bug references +;; bug-reference.el --- buttonize bug references -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2019 Free Software Foundation, Inc. @@ -91,7 +91,7 @@ The second subexpression should match the bug reference (usually a number)." (bug-reference-set-overlay-properties) (defun bug-reference-unfontify (start end) - "Remove bug reference overlays from region." + "Remove bug reference overlays from the region between START and END." (dolist (o (overlays-in start end)) (when (eq (overlay-get o 'category) 'bug-reference) (delete-overlay o)))) @@ -99,7 +99,7 @@ The second subexpression should match the bug reference (usually a number)." (defvar bug-reference-prog-mode) (defun bug-reference-fontify (start end) - "Apply bug reference overlays to region." + "Apply bug reference overlays to the region between START and END." (save-excursion (let ((beg-line (progn (goto-char start) (line-beginning-position))) (end-line (progn (goto-char end) (line-end-position)))) From 85fbdf027dc03e606c7c4532162148891e41d786 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Apr 2019 18:39:22 -0400 Subject: [PATCH 104/121] diff-font-lock-syntax: clarify distinction between t and hunk-also * lisp/vc/diff-mode.el (diff-font-lock-syntax): Rework docstring. (diff-syntax-fontify-hunk): Never use the hunk method when diff-font-lock-syntax is just t. --- lisp/vc/diff-mode.el | 132 +++++++++++++++++++++---------------------- 1 file changed, 63 insertions(+), 69 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index eeac24376e7..8940c7e09a6 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -116,7 +116,7 @@ You can always manually refine a hunk with `diff-refine-hunk'." "If non-nil, diff hunk font-lock includes source language syntax highlighting. This highlighting is the same as added by `font-lock-mode' when corresponding source files are visited normally. -Syntax highlighting is added over diff own highlighted changes. +Syntax highlighting is added over diff-mode's own highlighted changes. If t, the default, highlight syntax only in Diff buffers created by Diff commands that compare files or by VC commands that compare revisions. @@ -126,17 +126,17 @@ For diffs against the working-tree version of a file, the highlighting is based on the current file contents. File-based fontification tries to infer fontification from the compared files. -If revision-based or file-based method fails, use hunk-based method to get -fontification from hunk alone if the value is `hunk-also'. - -If `hunk-only', fontification is based on hunk alone, without full source. +If `hunk-only' fontification is based on hunk alone, without full source. It tries to highlight hunks without enough context that sometimes might result -in wrong fontification. This is the fastest option, but less reliable." +in wrong fontification. This is the fastest option, but less reliable. + +If `hunk-also', use reliable file-based syntax highlighting when available +and hunk-based syntax highlighting otherwise as a fallback." :version "27.1" :type '(choice (const :tag "Don't highlight syntax" nil) - (const :tag "Hunk-based also" hunk-also) (const :tag "Hunk-based only" hunk-only) - (const :tag "Highlight syntax" t))) + (const :tag "Highlight syntax" t) + (const :tag "Allow hunk-based fallback" hunk-also))) (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") @@ -2434,67 +2434,61 @@ When OLD is non-nil, highlight the hunk from the old source." (string-to-number (match-string 2 line))) (list (string-to-number line) 1)))) ; One-line diffs (props - (cond - ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only))) - (let* ((file (diff-find-file-name old t)) - (revision (and file (if (not old) (nth 1 diff-vc-revisions) - (or (nth 0 diff-vc-revisions) - (vc-working-revision file)))))) - (if file - (if (not revision) - ;; Get properties from the current working revision - (when (and (not old) (file-exists-p file) - (file-regular-p file)) - (let ((buf (get-file-buffer (expand-file-name file)))) - ;; Try to reuse an existing buffer - (if buf - (with-current-buffer buf - (diff-syntax-fontify-props nil text line-nb)) - ;; Get properties from the file - (with-temp-buffer - (insert-file-contents file) - (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - (expand-file-name file) - revision)) - (buffer (gethash buffer-name - diff-syntax-fontify-revisions))) - (unless (and buffer (buffer-live-p buffer)) - (let* ((vc-buffer (ignore-errors - (vc-find-revision-no-save - (expand-file-name file) revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when vc-buffer - (setq buffer vc-buffer) - (puthash buffer-name buffer - diff-syntax-fontify-revisions)))) - (when buffer - (with-current-buffer buffer - (diff-syntax-fontify-props file text line-nb))))) - ;; If file is unavailable, get properties from the hunk alone - (setq file (car (diff-hunk-file-names old))) - (with-temp-buffer - (insert text) - (diff-syntax-fontify-props file text line-nb t))))) - ((and diff-default-directory - (not (eq diff-font-lock-syntax 'hunk-only))) - (let ((file (car (diff-hunk-file-names old)))) - (if (and file (file-exists-p file) (file-regular-p file)) - ;; Try to get full text from the file - (with-temp-buffer - (insert-file-contents file) - (diff-syntax-fontify-props file text line-nb)) - ;; Otherwise, get properties from the hunk alone - (with-temp-buffer - (insert text) - (diff-syntax-fontify-props file text line-nb t))))) - ((memq diff-font-lock-syntax '(hunk-also hunk-only)) - (let ((file (car (diff-hunk-file-names old)))) - (with-temp-buffer - (insert text) - (diff-syntax-fontify-props file text line-nb t))))))) + (or + (when (and diff-vc-backend + (not (eq diff-font-lock-syntax 'hunk-only))) + (let* ((file (diff-find-file-name old t)) + (revision (and file (if (not old) (nth 1 diff-vc-revisions) + (or (nth 0 diff-vc-revisions) + (vc-working-revision file)))))) + (when file + (if (not revision) + ;; Get properties from the current working revision + (when (and (not old) (file-exists-p file) + (file-regular-p file)) + (let ((buf (get-file-buffer (expand-file-name file)))) + ;; Try to reuse an existing buffer + (if buf + (with-current-buffer buf + (diff-syntax-fontify-props nil text line-nb)) + ;; Get properties from the file + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb))))) + ;; Get properties from a cached revision + (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" + (expand-file-name file) + revision)) + (buffer (gethash buffer-name + diff-syntax-fontify-revisions))) + (unless (and buffer (buffer-live-p buffer)) + (let* ((vc-buffer (ignore-errors + (vc-find-revision-no-save + (expand-file-name file) revision + diff-vc-backend + (get-buffer-create buffer-name))))) + (when vc-buffer + (setq buffer vc-buffer) + (puthash buffer-name buffer + diff-syntax-fontify-revisions)))) + (when buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb)))))))) + (let ((file (car (diff-hunk-file-names old)))) + (cond + ((and file diff-default-directory + (not (eq diff-font-lock-syntax 'hunk-only)) + (not diff-vc-backend) + (file-readable-p file) (file-regular-p file)) + ;; Try to get full text from the file. + (with-temp-buffer + (insert-file-contents file) + (diff-syntax-fontify-props file text line-nb))) + ;; Otherwise, get properties from the hunk alone + ((memq diff-font-lock-syntax '(hunk-also hunk-only)) + (with-temp-buffer + (insert text) + (diff-syntax-fontify-props file text line-nb t)))))))) ;; Put properties over the hunk text (goto-char beg) From 44a39e3e761c0774cd1bb9360db7f49e1d66ec06 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 9 Apr 2019 15:42:10 -0700 Subject: [PATCH 105/121] Remove dmpstruct.h MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The hassles of updating the dmpstruct.h-using code bit me again. These updates are more trouble than they’re worth. See: https://lists.gnu.org/r/emacs-devel/2019-03/msg00122.html As I’m the main person who’s made changes in this area since dmpstruct.h was introduced, I’m the most motivated to clean up the situation. * make-dist (possibly_non_vc_files): Remove src/dmpstruct.h. * src/Makefile.in (dmpstruct_headers, dmpstruct.h): Remove. (pdumper.o): Do not depend on dmpstruct.h. (mostlyclean): Do not remove dmpstruct.h. * src/dmpstruct.awk: Remove. * src/pdumper.c: Do not include dmpstruct.h. (CHECK_STRUCTS): Remove. All uses removed. --- .gitignore | 1 - make-dist | 2 +- src/Makefile.in | 10 +----- src/dmpstruct.awk | 45 ------------------------ src/pdumper.c | 89 ----------------------------------------------- 5 files changed, 2 insertions(+), 145 deletions(-) delete mode 100755 src/dmpstruct.awk diff --git a/.gitignore b/.gitignore index 355824f3903..bd5a8e79471 100644 --- a/.gitignore +++ b/.gitignore @@ -187,7 +187,6 @@ src/emacs-[0-9]* src/temacs src/temacs.in src/fingerprint.c -src/dmpstruct.h src/*.pdmp # Character-set info. diff --git a/make-dist b/make-dist index 4e18d77a87b..821895a0053 100755 --- a/make-dist +++ b/make-dist @@ -366,7 +366,7 @@ possibly_non_vc_files=" $top_level_ChangeLog MANIFEST aclocal.m4 configure admin/charsets/jisx2131-filter - src/config.in src/dmpstruct.h src/emacs-module.h + src/config.in src/emacs-module.h src/fingerprint.c "$( find admin doc etc lisp \ diff --git a/src/Makefile.in b/src/Makefile.in index dee3a534db3..10b2da319b2 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -456,14 +456,6 @@ ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES) .PHONY: all -dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \ - $(srcdir)/intervals.h $(srcdir)/charset.h $(srcdir)/bignum.h -pdumper.o: dmpstruct.h -dmpstruct.h: $(srcdir)/dmpstruct.awk -dmpstruct.h: $(libsrc)/make-fingerprint$(EXEEXT) $(dmpstruct_headers) - $(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \ - $(dmpstruct_headers) > $@ - AUTO_DEPEND = @AUTO_DEPEND@ DEPDIR = deps ifeq ($(AUTO_DEPEND),yes) @@ -681,7 +673,7 @@ ns-app: emacs$(EXEEXT) $(pdmp) mostlyclean: rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o - rm -f temacs.in$(EXEEXT) fingerprint.c dmpstruct.h + rm -f temacs.in$(EXEEXT) fingerprint.c rm -f emacs.pdmp rm -f ../etc/DOC rm -f bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) diff --git a/src/dmpstruct.awk b/src/dmpstruct.awk deleted file mode 100755 index 55626cf8b21..00000000000 --- a/src/dmpstruct.awk +++ /dev/null @@ -1,45 +0,0 @@ -# Copyright (C) 2018-2019 Free Software Foundation, Inc. -# -# This file is part of GNU Emacs. -# -# GNU Emacs is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or (at -# your option) any later version. -# -# GNU Emacs is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GNU Emacs. If not, see . - -BEGIN { - print "/* Generated by dmpstruct.awk */" - print "#ifndef EMACS_DMPSTRUCT_H" - print "#define EMACS_DMPSTRUCT_H" - struct_name = "" - tmpfile = "dmpstruct.tmp" -} -# Match a type followed by optional syntactic whitespace -/^(enum|struct|union) [a-zA-Z0-9_]+([\t ]|\/\*.*\*\/)*$/ { - struct_name = $2 - close (tmpfile) -} -/^(enum|struct|union) [a-zA-Z0-9_]+([\t ]|\/\*.*\*\/)*$/, /^( )?};$/ { - print $0 > tmpfile -} -/^( )?} *(GCALIGNED_STRUCT)? *;$/ { - if (struct_name != "") { - fflush (tmpfile) - cmd = "../lib-src/make-fingerprint -r " tmpfile - cmd | getline hash - close (cmd) - printf "#define HASH_%s_%.10s\n", struct_name, hash - struct_name = "" - } -} -END { - print "#endif /* EMACS_DMPSTRUCT_H */" -} diff --git a/src/pdumper.c b/src/pdumper.c index cb2915cb203..68c412d47cd 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -46,8 +46,6 @@ along with GNU Emacs. If not, see . */ #include "thread.h" #include "bignum.h" -#include "dmpstruct.h" - /* TODO: @@ -68,16 +66,6 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_PDUMPER -/* CHECK_STRUCTS being true makes the build break if we notice - changes to the source defining certain Lisp structures we dump. If - you change one of these structures, check that the pdumper code is - still valid, and update the pertinent hash lower down in this file - (pdumper.c) by manually copying the value from the dmpstruct.h - generated from your new code. */ -#ifndef CHECK_STRUCTS -# define CHECK_STRUCTS 1 -#endif - #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7) # pragma GCC diagnostic error "-Wconversion" # pragma GCC diagnostic error "-Wshadow" @@ -2043,9 +2031,6 @@ dump_pseudovector_lisp_fields (struct dump_context *ctx, static dump_off dump_cons (struct dump_context *ctx, const struct Lisp_Cons *cons) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Cons_00EEE63F67) -# error "Lisp_Cons changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Cons out; dump_object_start (ctx, &out, sizeof (out)); dump_field_lv (ctx, &out, cons, &cons->u.s.car, WEIGHT_STRONG); @@ -2058,9 +2043,6 @@ dump_interval_tree (struct dump_context *ctx, INTERVAL tree, dump_off parent_offset) { -#if CHECK_STRUCTS && !defined (HASH_interval_1B38941C37) -# error "interval changed. See CHECK_STRUCTS comment." -#endif /* TODO: output tree breadth-first? */ struct interval out; dump_object_start (ctx, &out, sizeof (out)); @@ -2102,9 +2084,6 @@ dump_interval_tree (struct dump_context *ctx, static dump_off dump_string (struct dump_context *ctx, const struct Lisp_String *string) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_String_86FEA6EC7C) -# error "Lisp_String changed. See CHECK_STRUCTS comment." -#endif /* If we have text properties, write them _after_ the string so that at runtime, the prefetcher and cache will DTRT. (We access the string before its properties.). @@ -2148,10 +2127,6 @@ dump_string (struct dump_context *ctx, const struct Lisp_String *string) static dump_off dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Marker_642DBAF866) -# error "Lisp_Marker changed. See CHECK_STRUCTS comment." -#endif - START_DUMP_PVEC (ctx, &marker->header, struct Lisp_Marker, out); dump_pseudovector_lisp_fields (ctx, &out->header, &marker->header); DUMP_FIELD_COPY (out, marker, need_adjustment); @@ -2171,9 +2146,6 @@ dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker) static dump_off dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_72EADA9882) -# error "Lisp_Overlay changed. See CHECK_STRUCTS comment." -#endif START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out); dump_pseudovector_lisp_fields (ctx, &out->header, &overlay->header); dump_field_lv_rawptr (ctx, out, overlay, &overlay->next, @@ -2199,9 +2171,6 @@ static dump_off dump_finalizer (struct dump_context *ctx, const struct Lisp_Finalizer *finalizer) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Finalizer_D58E647CB8) -# error "Lisp_Finalizer changed. See CHECK_STRUCTS comment." -#endif START_DUMP_PVEC (ctx, &finalizer->header, struct Lisp_Finalizer, out); /* Do _not_ call dump_pseudovector_lisp_fields here: we dump the only Lisp field, finalizer->function, manually, so we can give it @@ -2221,9 +2190,6 @@ struct bignum_reload_info static dump_off dump_bignum (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Bignum_661945DE2B) -# error "Lisp_Bignum changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Bignum *bignum = XBIGNUM (object); START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out); verify (sizeof (out->value) >= sizeof (struct bignum_reload_info)); @@ -2259,9 +2225,6 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object) static dump_off dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Float_50A7B216D9) -# error "Lisp_Float changed. See CHECK_STRUCTS comment." -#endif eassert (ctx->header.cold_start); struct Lisp_Float out; dump_object_start (ctx, &out, sizeof (out)); @@ -2272,9 +2235,6 @@ dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) static dump_off dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Intfwd_4D887A7387 -# error "Lisp_Intfwd changed. See CHECK_STRUCTS comment." -#endif dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar); struct Lisp_Intfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2286,9 +2246,6 @@ dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd) static dump_off dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Boolfwd_0EA1C7ADCC) -# error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment." -#endif dump_emacs_reloc_immediate_bool (ctx, boolfwd->boolvar, *boolfwd->boolvar); struct Lisp_Boolfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2300,9 +2257,6 @@ dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd) static dump_off dump_fwd_obj (struct dump_context *ctx, const struct Lisp_Objfwd *objfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Objfwd_45D3E513DC) -# error "Lisp_Objfwd changed. See CHECK_STRUCTS comment." -#endif if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objfwd->objvar)), ctx->staticpro_table, Qnil))) @@ -2318,9 +2272,6 @@ static dump_off dump_fwd_buffer_obj (struct dump_context *ctx, const struct Lisp_Buffer_Objfwd *buffer_objfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Objfwd_13CA6B04FC) -# error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Buffer_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, buffer_objfwd, type); @@ -2334,9 +2285,6 @@ static dump_off dump_fwd_kboard_obj (struct dump_context *ctx, const struct Lisp_Kboard_Objfwd *kboard_objfwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Kboard_Objfwd_CAA7E71069) -# error "Lisp_Intfwd changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Kboard_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, kboard_objfwd, type); @@ -2347,9 +2295,6 @@ dump_fwd_kboard_obj (struct dump_context *ctx, static dump_off dump_fwd (struct dump_context *ctx, lispfwd fwd) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_Type_9CBA6EE55E) -# error "Lisp_Fwd_Type changed. See CHECK_STRUCTS comment." -#endif void const *p = fwd.fwdptr; dump_off offset; @@ -2381,9 +2326,6 @@ static dump_off dump_blv (struct dump_context *ctx, const struct Lisp_Buffer_Local_Value *blv) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Buffer_Local_Value_3C363FAC3C -# error "Lisp_Buffer_Local_Value changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Buffer_Local_Value out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, blv, local_if_set); @@ -2446,13 +2388,6 @@ dump_symbol (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC -# error "Lisp_Symbol changed. See CHECK_STRUCTS comment." -#endif -#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113) -# error "symbol_redirect changed. See CHECK_STRUCTS comment." -#endif - if (ctx->flags.defer_symbols) { if (offset != DUMP_OBJECT_ON_SYMBOL_QUEUE) @@ -2542,9 +2477,6 @@ static dump_off dump_vectorlike_generic (struct dump_context *ctx, const union vectorlike_header *header) { -#if CHECK_STRUCTS && !defined (HASH_vectorlike_header_00A5A4BFB2) -# error "vectorlike_header changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Vector *v = (const struct Lisp_Vector *) header; ptrdiff_t size = header->size; enum pvec_type pvectype = PSEUDOVECTOR_TYPE (v); @@ -2702,9 +2634,6 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_EF95ED06FF -# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); bool is_stable = dump_hash_table_stable_p (hash_in); /* If the hash table is likely to be modified in memory (either @@ -2770,9 +2699,6 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_E34A11C6B9 -# error "buffer changed. See CHECK_STRUCTS comment." -#endif struct buffer munged_buffer = *in_buffer; struct buffer *buffer = &munged_buffer; @@ -2906,9 +2832,6 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) static dump_off dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Vector_3091289B35) -# error "Lisp_Vector changed. See CHECK_STRUCTS comment." -#endif /* No relocation needed, so we don't need dump_object_start. */ dump_align_output (ctx, DUMP_ALIGNMENT); eassert (ctx->offset >= ctx->header.cold_start); @@ -2923,9 +2846,6 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_594AB72B54) -# error "Lisp_Subr changed. See CHECK_STRUCTS comment." -#endif struct Lisp_Subr out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, subr, header.size); @@ -2962,9 +2882,6 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined (HASH_pvec_type_549C833A54) -# error "pvec_type changed. See CHECK_STRUCTS comment." -#endif const struct Lisp_Vector *v = XVECTOR (lv); switch (PSEUDOVECTOR_TYPE (v)) { @@ -3072,9 +2989,6 @@ dump_vectorlike (struct dump_context *ctx, static dump_off dump_object (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Type_E2AD97D3F7) -# error "Lisp_Type changed. See CHECK_STRUCTS comment." -#endif #ifdef ENABLE_CHECKING /* Vdead is extern only when ENABLE_CHECKING. */ eassert (!EQ (object, Vdead)); @@ -3177,9 +3091,6 @@ dump_object_for_offset (struct dump_context *ctx, Lisp_Object object) static dump_off dump_charset (struct dump_context *ctx, int cs_i) { -#if CHECK_STRUCTS && !defined (HASH_charset_317C49E291) -# error "charset changed. See CHECK_STRUCTS comment." -#endif dump_align_output (ctx, alignof (int)); const struct charset *cs = charset_table + cs_i; struct charset out; From e44ff2de819ead77b00c7fb4ede75ada685ff099 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 9 Apr 2019 15:42:10 -0700 Subject: [PATCH 106/121] Remove assumption of uint64_t etc. in portable code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit C11 doesn’t guarantee the existence of types like uint64_t, so avoid these types in portable code, as it’s easy to do so. There’s no need to avoid the types in w32-specific code, since w32 is guaranteed to have them. * lib-src/make-fingerprint.c (main): * src/fingerprint-dummy.c: * src/fingerprint.h: * src/pdumper.c (dump_fingerprint, struct dump_header): Prefer unsigned char to uint8_t in portable code, as either will do. Put an "#include " in fingerprint.c files, so that the corresponding .o file is rebuilt after ./configure is run. * lib-src/make-fingerprint.c (main): Simplify loop. * src/Makefile.in (fingerprint.c): Update atomically. * src/pdumper.c: Omit unnecessary check that off_t is the same size as int32_t or int64_t, as the code does not rely on this assumption. (dump_off): Use int_least32_t, not int32_t. (struct dump_reloc): Use unsigned int, not uint32_t. (dump_anonymous_allocate_w32, dump_anonymous_allocate_posix) (dump_anonymous_allocate, dump_map_file_w32, dump_map_file_posix) (dump_map_file: Do the sanity checks at compile time, not at run-time, to avoid usage of uint64_t etc. on non-w32 platforms. --- lib-src/make-fingerprint.c | 12 ++--- src/Makefile.in | 4 +- src/fingerprint-dummy.c | 4 +- src/fingerprint.h | 4 +- src/pdumper.c | 93 ++++++++++++++------------------------ 5 files changed, 47 insertions(+), 70 deletions(-) diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c index d310366442d..4bfeaa0742c 100644 --- a/lib-src/make-fingerprint.c +++ b/lib-src/make-fingerprint.c @@ -89,7 +89,7 @@ main (int argc, char **argv) fclose (f); } - uint8_t digest[32]; + unsigned char digest[32]; sha256_finish_ctx (&ctx, digest); if (raw) @@ -99,12 +99,12 @@ main (int argc, char **argv) } else { - printf ("#include \"fingerprint.h\"\n"); - printf ("\n"); - printf ("const uint8_t fingerprint[32] = { "); + puts ("#include \n" + "#include \"fingerprint.h\"\n" + "unsigned char const fingerprint[] = {"); for (int i = 0; i < 32; ++i) - printf ("%s0x%02X", i ? ", " : "", digest[i]); - printf (" };\n"); + printf ("\t0x%02X,\n", digest[i]); + puts ("};"); } return EXIT_SUCCESS; diff --git a/src/Makefile.in b/src/Makefile.in index 10b2da319b2..0613a0dbed4 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -629,7 +629,9 @@ $(libsrc)/make-fingerprint$(EXEEXT): $(libsrc)/make-fingerprint.c $(lib)/libgnu. $(MAKE) -C $(libsrc) make-fingerprint$(EXEEXT) fingerprint.c: temacs.in$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT) - $(libsrc)/make-fingerprint$(EXEEXT) temacs.in$(EXEEXT) > fingerprint.c + $(AM_V_GEN)$(libsrc)/make-fingerprint$(EXEEXT) temacs.in$(EXEEXT) \ + >$@.tmp + $(AM_V_at)mv $@.tmp $@ ## We have to create $(etc) here because init_cmdargs tests its ## existence when setting Vinstallation_directory (FIXME?). diff --git a/src/fingerprint-dummy.c b/src/fingerprint-dummy.c index 1603519783e..04938bd1d08 100644 --- a/src/fingerprint-dummy.c +++ b/src/fingerprint-dummy.c @@ -17,7 +17,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +#include + #include "fingerprint.h" /* Dummy fingerprint to use as hash input. */ -const uint8_t fingerprint[32] = { 0 }; +unsigned char const fingerprint[32] = { 0 }; diff --git a/src/fingerprint.h b/src/fingerprint.h index 913b668b4e0..0b195fd0ca7 100644 --- a/src/fingerprint.h +++ b/src/fingerprint.h @@ -20,12 +20,10 @@ along with GNU Emacs. If not, see . */ #ifndef EMACS_FINGERPRINT_H #define EMACS_FINGERPRINT_H -#include - /* We generate fingerprint.c and fingerprint.o from all the sources in Emacs. This way, we have a unique value that we can use to pair data files (like a portable dump image) with a specific build of Emacs. */ -extern const uint8_t fingerprint[32]; +extern unsigned char const fingerprint[32]; #endif diff --git a/src/pdumper.c b/src/pdumper.c index 68c412d47cd..3aa941221db 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -123,8 +123,6 @@ verify (sizeof (intptr_t) == sizeof (ptrdiff_t)); verify (sizeof (void (*)(void)) == sizeof (void *)); verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object)); verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT)); -verify (sizeof (off_t) == sizeof (int32_t) - || sizeof (off_t) == sizeof (int64_t)); verify (CHAR_BIT == 8); #define DIVIDE_ROUND_UP(x, y) (((x) + (y) - 1) / (y)) @@ -145,9 +143,9 @@ static struct } remembered_data[32]; static int nr_remembered_data = 0; -typedef int32_t dump_off; -#define DUMP_OFF_MIN INT32_MIN -#define DUMP_OFF_MAX INT32_MAX +typedef int_least32_t dump_off; +#define DUMP_OFF_MIN INT_LEAST32_MIN +#define DUMP_OFF_MAX INT_LEAST32_MAX __attribute__((format (printf,1,2))) static void @@ -290,10 +288,10 @@ verify (DUMP_ALIGNMENT >= GCALIGNMENT); struct dump_reloc { - uint32_t raw_offset : DUMP_RELOC_OFFSET_BITS; + unsigned int raw_offset : DUMP_RELOC_OFFSET_BITS; ENUM_BF (dump_reloc_type) type : DUMP_RELOC_TYPE_BITS; }; -verify (sizeof (struct dump_reloc) == sizeof (int32_t)); +verify (sizeof (struct dump_reloc) == sizeof (dump_off)); /* Set the type of a dump relocation. @@ -323,7 +321,7 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset) } static void -dump_fingerprint (const char *label, const uint8_t *xfingerprint) +dump_fingerprint (const char *label, unsigned char const *xfingerprint) { fprintf (stderr, "%s: ", label); for (int i = 0; i < 32; ++i) @@ -354,7 +352,7 @@ struct dump_header char magic[sizeof (dump_magic)]; /* Associated Emacs binary. */ - uint8_t fingerprint[32]; + unsigned char fingerprint[32]; /* Relocation table for the dump file; each entry is a struct dump_reloc. */ @@ -4230,17 +4228,12 @@ enum dump_memory_protection DUMP_MEMORY_ACCESS_READWRITE = 3, }; +#if VM_SUPPORTED == VM_MS_WINDOWS static void * dump_anonymous_allocate_w32 (void *base, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_MS_WINDOWS - (void) base; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret; DWORD mem_type; DWORD mem_prot; @@ -4269,26 +4262,22 @@ dump_anonymous_allocate_w32 (void *base, ? EBUSY : EPERM; return ret; -#endif } +#endif + +#if VM_SUPPORTED == VM_POSIX /* Old versions of macOS only define MAP_ANON, not MAP_ANONYMOUS. FIXME: This probably belongs elsewhere (gnulib/autoconf?) */ -#ifndef MAP_ANONYMOUS -#define MAP_ANONYMOUS MAP_ANON -#endif +# ifndef MAP_ANONYMOUS +# define MAP_ANONYMOUS MAP_ANON +# endif static void * dump_anonymous_allocate_posix (void *base, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_POSIX - (void) base; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret; int mem_prot; @@ -4333,8 +4322,8 @@ dump_anonymous_allocate_posix (void *base, if (ret == MAP_FAILED) ret = NULL; return ret; -#endif } +#endif /* Perform anonymous memory allocation. */ static void * @@ -4342,14 +4331,14 @@ dump_anonymous_allocate (void *base, const size_t size, enum dump_memory_protection protection) { - void *ret = NULL; - if (VM_SUPPORTED == VM_MS_WINDOWS) - ret = dump_anonymous_allocate_w32 (base, size, protection); - else if (VM_SUPPORTED == VM_POSIX) - ret = dump_anonymous_allocate_posix (base, size, protection); - else - errno = ENOSYS; - return ret; +#if VM_SUPPORTED == VM_POSIX + return dump_anonymous_allocate_posix (base, size, protection); +#elif VM_SUPPORTED == VM_MS_WINDOWS + return dump_anonymous_allocate_w32 (base, size, protection); +#else + errno = ENOSYS; + return NULL; +#endif } /* Undo the effect of dump_reserve_address_space(). */ @@ -4371,18 +4360,11 @@ dump_anonymous_release (void *addr, size_t size) #endif } +#if VM_SUPPORTED == VM_MS_WINDOWS static void * dump_map_file_w32 (void *base, int fd, off_t offset, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_MS_WINDOWS - (void) base; - (void) fd; - (void) offset; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret = NULL; HANDLE section = NULL; HANDLE file; @@ -4437,21 +4419,14 @@ dump_map_file_w32 (void *base, int fd, off_t offset, size_t size, if (section && !CloseHandle (section)) emacs_abort (); return ret; -#endif } +#endif +#if VM_SUPPORTED == VM_POSIX static void * dump_map_file_posix (void *base, int fd, off_t offset, size_t size, enum dump_memory_protection protection) { -#if VM_SUPPORTED != VM_POSIX - (void) base; - (void) fd; - (void) offset; - (void) size; - (void) protection; - emacs_abort (); -#else void *ret; int mem_prot; int mem_flags; @@ -4481,22 +4456,22 @@ dump_map_file_posix (void *base, int fd, off_t offset, size_t size, if (ret == MAP_FAILED) ret = NULL; return ret; -#endif } +#endif /* Map a file into memory. */ static void * dump_map_file (void *base, int fd, off_t offset, size_t size, enum dump_memory_protection protection) { - void *ret = NULL; - if (VM_SUPPORTED == VM_MS_WINDOWS) - ret = dump_map_file_w32 (base, fd, offset, size, protection); - else if (VM_SUPPORTED == VM_POSIX) - ret = dump_map_file_posix (base, fd, offset, size, protection); - else - errno = ENOSYS; +#if VM_SUPPORTED == VM_POSIX + return dump_map_file_posix (base, fd, offset, size, protection); +#elif VM_SUPPORTED == VM_MS_WINDOWS + return dump_map_file_w32 (base, fd, offset, size, protection); +#else + errno = ENOSYS; return ret; +#endif } /* Remove a virtual memory mapping. From d82603747564063f908c9c877449c827a9808528 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 9 Apr 2019 15:42:10 -0700 Subject: [PATCH 107/121] Remove the need for temacs.in MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Instead of building a file temacs.in used only to compute a fingerprint, compute the fingerprint directly from the .o and .a files that go into temacs.in. This speeds up the build by avoiding the need to link temacs twice, once with a dummy fingerprint. * lib-src/make-fingerprint.c (main): No need to generate a fingerprint file that includes config.h, now that fingerprint.c depends on all the .o files. * src/Makefile.in ($(libsrc)/make-fingerprint$(EXEEXT)): Use the same rule as $(libsrc)/make-docfile$(EXEEXT). * src/fingerprint-dummy.c: Remove. * src/Makefile.in (${charsets}, $(libsrc)/make-docfile$(EXEEXT)) ($(LIBEGNU_ARCHIVE), $(lwlibdir)/liblw.a, $(oldXMenudir)/libXMenu11.a) (../config.status, ${ETAGS}, ../lisp/TAGS, $(lwlibdir)/TAGS) ($(lispsource)/loaddefs.el): Prefer ‘$(MAKE) -C $(dir $@)’ to ‘${MAKE} -C SOMESTRING’ when either will do, as the former is more regular and lets us coalesce rules better. (EMACS_DEPS_PRE, EMACS_DEPS_POST, BUILD_EMACS_PRE) (BUILD_EMACS_POST, temacs.in$(EXEEXT)): Remove. (FINGERPRINTED): New macro. (fingerprint.c): Use it instead of temacs.in$(EXEEXT), to avoid the need to build temacs.in at all. (temacs$(EXEEXT)): No need to depend on other .o files now; fingerprint.o is enough, since it depends on the rest. Spell out what used to be in BUILD_EMACS_PRE and BUILD_EMACS_POST. (mostlyclean): No need to remove temacs.in. --- .gitignore | 1 - lib-src/make-fingerprint.c | 6 ++--- src/Makefile.in | 53 ++++++++++++++------------------------ src/fingerprint-dummy.c | 25 ------------------ 4 files changed, 23 insertions(+), 62 deletions(-) delete mode 100644 src/fingerprint-dummy.c diff --git a/.gitignore b/.gitignore index bd5a8e79471..98b8222180b 100644 --- a/.gitignore +++ b/.gitignore @@ -185,7 +185,6 @@ src/bootstrap-emacs src/emacs src/emacs-[0-9]* src/temacs -src/temacs.in src/fingerprint.c src/*.pdmp diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c index 4bfeaa0742c..35bb8b98a00 100644 --- a/lib-src/make-fingerprint.c +++ b/lib-src/make-fingerprint.c @@ -99,9 +99,9 @@ main (int argc, char **argv) } else { - puts ("#include \n" - "#include \"fingerprint.h\"\n" - "unsigned char const fingerprint[] = {"); + puts ("#include \"fingerprint.h\"\n" + "unsigned char const fingerprint[] =\n" + "{"); for (int i = 0; i < 32; ++i) printf ("\t0x%02X,\n", digest[i]); puts ("};"); diff --git a/src/Makefile.in b/src/Makefile.in index 0613a0dbed4..f8a2ffadc27 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -533,7 +533,7 @@ ${lispintdir}/cp51932.el ${lispintdir}/eucjp-ms.el: FORCE charsets = ${top_srcdir}/admin/charsets/charsets.stamp ${charsets}: FORCE - ${MAKE} -C ../admin/charsets all + $(MAKE) -C $(dir $@) all charscript = ${lispintdir}/charscript.el ${charscript}: FORCE @@ -584,8 +584,9 @@ $(etc)/DOC: lisp.mk $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp) $(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \ $(shortlisp) -$(libsrc)/make-docfile$(EXEEXT): $(lib)/libgnu.a - $(MAKE) -C $(libsrc) make-docfile$(EXEEXT) +$(libsrc)/make-docfile$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT): \ + $(lib)/libgnu.a + $(MAKE) -C $(dir $@) $(notdir $@) buildobj.h: Makefile $(AM_V_GEN)for i in $(ALLOBJS); do \ @@ -613,32 +614,21 @@ $(ALLOBJS): globals.h LIBEGNU_ARCHIVE = $(lib)/lib$(if $(HYBRID_MALLOC),e)gnu.a $(LIBEGNU_ARCHIVE): $(config_h) - $(MAKE) -C $(lib) all + $(MAKE) -C $(dir $@) all -EMACS_DEPS_PRE=$(LIBXMENU) $(ALLOBJS) -EMACS_DEPS_POST=$(LIBEGNU_ARCHIVE) $(EMACSRES) ${charsets} ${charscript} -BUILD_EMACS_PRE=$(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ - -o $@ $(ALLOBJS) -BUILD_EMACS_POST=$(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) - -## We hash this file to generate the build fingerprint -temacs.in$(EXEEXT): $(EMACS_DEPS_PRE) fingerprint-dummy.o $(EMACS_DEPS_POST) - $(BUILD_EMACS_PRE) fingerprint-dummy.o $(BUILD_EMACS_POST) - -$(libsrc)/make-fingerprint$(EXEEXT): $(libsrc)/make-fingerprint.c $(lib)/libgnu.a - $(MAKE) -C $(libsrc) make-fingerprint$(EXEEXT) - -fingerprint.c: temacs.in$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT) - $(AM_V_GEN)$(libsrc)/make-fingerprint$(EXEEXT) temacs.in$(EXEEXT) \ - >$@.tmp +FINGERPRINTED = $(LIBXMENU) $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(EMACSRES) +fingerprint.c: $(FINGERPRINTED) $(libsrc)/make-fingerprint$(EXEEXT) + $(AM_V_GEN)$(libsrc)/make-fingerprint$(EXEEXT) $(FINGERPRINTED) >$@.tmp $(AM_V_at)mv $@.tmp $@ ## We have to create $(etc) here because init_cmdargs tests its ## existence when setting Vinstallation_directory (FIXME?). ## This goes on to affect various things, and the emacs binary fails ## to start if Vinstallation_directory has the wrong value. -temacs$(EXEEXT): $(EMACS_DEPS_PRE) fingerprint.o $(EMACS_DEPS_POST) - $(BUILD_EMACS_PRE) fingerprint.o $(BUILD_EMACS_POST) +temacs$(EXEEXT): fingerprint.o $(charsets) $(charscript) + $(AM_V_CCLD)$(CC) -o $@ $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ + $(ALLOBJS) fingerprint.o \ + $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES) $(MKDIR_P) $(etc) ifeq ($(DUMPING),unexec) ifneq ($(PAXCTL_notdumped),) @@ -649,15 +639,15 @@ endif ## The following oldxmenu-related rules are only (possibly) used if ## HAVE_X11 && !USE_GTK, but there is no harm in always defining them. $(lwlibdir)/liblw.a: $(config_h) globals.h lisp.h FORCE - $(MAKE) -C $(lwlibdir) liblw.a + $(MAKE) -C $(dir $@) $(notdir $@) $(oldXMenudir)/libXMenu11.a: FORCE - $(MAKE) -C $(oldXMenudir) libXMenu11.a + $(MAKE) -C $(dir $@) $(notdir $@) FORCE: .PHONY: FORCE .PRECIOUS: ../config.status Makefile ../config.status: $(top_srcdir)/configure.ac $(top_srcdir)/m4/*.m4 - $(MAKE) -C .. $(notdir $@) + $(MAKE) -C $(dir $@) $(notdir $@) Makefile: ../config.status $(srcdir)/Makefile.in $(MAKE) -C .. src/$@ @@ -675,7 +665,7 @@ ns-app: emacs$(EXEEXT) $(pdmp) mostlyclean: rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o - rm -f temacs.in$(EXEEXT) fingerprint.c + rm -f fingerprint.c rm -f emacs.pdmp rm -f ../etc/DOC rm -f bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) @@ -713,7 +703,7 @@ extraclean: distclean ETAGS = ../lib-src/etags${EXEEXT} ${ETAGS}: FORCE - ${MAKE} -C ../lib-src $(notdir $@) + $(MAKE) -C $(dir $@) $(notdir $@) # Remove macuvs.h and fingerprint.c since they'd cause `src/emacs` # to be built before we can get TAGS. @@ -738,11 +728,8 @@ TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2) ## Arrange to make tags tables for ../lisp and ../lwlib, ## which the above TAGS file for the C files includes by reference. -../lisp/TAGS: FORCE - $(MAKE) -C ../lisp TAGS ETAGS="$(ETAGS)" - -$(lwlibdir)/TAGS: FORCE - $(MAKE) -C $(lwlibdir) TAGS ETAGS="$(ETAGS)" +../lisp/TAGS $(lwlibdir)/TAGS: FORCE + $(MAKE) -C $(dir $@) $(notdir $@) ETAGS="$(ETAGS)" tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS .PHONY: tags @@ -778,7 +765,7 @@ VCSWITNESS = $(lispsource)/loaddefs.el: $(VCSWITNESS) | \ bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) - $(MAKE) -C ../lisp autoloads EMACS="$(bootstrap_exe)" + $(MAKE) -C $(dir $@) autoloads EMACS="$(bootstrap_exe)" ## Dump an Emacs executable named bootstrap-emacs containing the ## files from loadup.el in source form. diff --git a/src/fingerprint-dummy.c b/src/fingerprint-dummy.c deleted file mode 100644 index 04938bd1d08..00000000000 --- a/src/fingerprint-dummy.c +++ /dev/null @@ -1,25 +0,0 @@ -/* Dummy fingerprint - -Copyright (C) 2016, 2018-2019 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include - -#include "fingerprint.h" - -/* Dummy fingerprint to use as hash input. */ -unsigned char const fingerprint[32] = { 0 }; From 8d2f1df51aa02c101a3ce4655ff6ed6d2b64e4cf Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Thu, 22 Nov 2018 13:00:03 -0800 Subject: [PATCH 108/121] Address name conflicts in EIEIO documentation (bug#31660) * doc/misc/eieio.texi (Quick Start): Rename the class used in the example from 'record' to 'person'. (Building Classes): Advise user to check for name conflicts before naming a class. Add a missing apostrophe. (Making New Objects): Correct grammar. Rename the class used in the example from 'record' to 'my-class'. --- doc/misc/eieio.texi | 52 ++++++++++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 22 deletions(-) diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index d03ee79f18b..f56b2b67a40 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -88,11 +88,11 @@ framework for writing object-oriented applications in Emacs. use @eieio{} to create classes, methods for those classes, and instances of classes. -Here is a simple example of a class named @code{record}, containing +Here is a simple example of a class named @code{person}, containing three slots named @code{name}, @code{birthday}, and @code{phone}: @example -(defclass record () ; No superclasses +(defclass person () ; No superclasses ((name :initarg :name :initform "" :type string @@ -106,23 +106,23 @@ three slots named @code{name}, @code{birthday}, and @code{phone}: (phone :initarg :phone :initform "" :documentation "Phone number.")) - "A single record for tracking people I know.") + "A class for tracking people I know.") @end example Each class can have methods, which are defined like this: @example -(cl-defmethod call-record ((rec record) &optional scriptname) - "Dial the phone for the record REC. +(cl-defmethod call-person ((pers person) &optional scriptname) + "Dial the phone for the person PERS. Execute the program SCRIPTNAME to dial the phone." - (message "Dialing the phone for %s" (oref rec name)) + (message "Dialing the phone for %s" (oref pers name)) (shell-command (concat (or scriptname "dialphone.sh") " " - (oref rec phone)))) + (oref pers phone)))) @end example @noindent -In this example, the first argument to @code{call-record} is a list, +In this example, the first argument to @code{call-person} is a list, of the form (@var{varname} @var{classname}). @var{varname} is the name of the variable used for the first argument; @var{classname} is the name of the class that is expected as the first argument for this @@ -130,17 +130,17 @@ method. @eieio{} dispatches methods based on the type of the first argument. You can have multiple methods with the same name for different classes -of object. When the @code{call-record} method is called, the first +of object. When the @code{call-person} method is called, the first argument is examined to determine the class of that argument, and the method matching the input type is then executed. Once the behavior of a class is defined, you can create a new -object of type @code{record}. Objects are created by calling the +object of type @code{person}. Objects are created by calling the constructor. The constructor is a function with the same name as your class which returns a new instance of that class. Here is an example: @example -(setq rec (record :name "Eric" :birthday "June" :phone "555-5555")) +(setq pers (person :name "Eric" :birthday "June" :phone "555-5555")) @end example @noindent @@ -157,19 +157,19 @@ first argument should be an object of a class which has had this method defined for it. In this example it would look like this: @example -(call-record rec) +(call-person pers) @end example @noindent or @example -(call-record rec "my-call-script") +(call-person pers "my-call-script") @end example In these examples, @eieio{} automatically examines the class of -@code{rec}, and ensures that the method defined above is called. If -@code{rec} is some other class lacking a @code{call-record} method, or +@code{pers}, and ensures that the method defined above is called. If +@code{pers} is some other class lacking a @code{call-person} method, or some other data type, Emacs signals a @code{cl-no-applicable-method} error. @ref{Signals}. @@ -270,10 +270,18 @@ by a symbol with the name @var{class-name}. @eieio{} stores the structure of the class as a symbol property of @var{class-name} (@pxref{Symbol Components,,,elisp,GNU Emacs Lisp Reference Manual}). +When defining a class, @eieio{} overwrites any preexisting variable or +function bindings for the symbol @var{class-name}, which may lead to +undesired consequences. Before naming a new class, you should check +for name conflicts. To help avoid cross-package conflicts you should +choose a name with the same prefix you chose for the rest of your +package's functions and variables (@pxref{Coding +Conventions,,,elisp,GNU Emacs Lisp Reference Manual}). + The @var{class-name} symbol's variable documentation string is a modified version of the doc string found in @var{options-and-doc}. Each time a method is defined, the symbol's documentation string is -updated to include the methods documentation as well. +updated to include the method's documentation as well. The parent classes for @var{class-name} is @var{superclass-list}. Each element of @var{superclass-list} must be a class. These classes @@ -625,10 +633,10 @@ function of @code{:initform}. @node Making New Objects @chapter Making New Objects -Suppose we have a simple class is defined, such as: +Suppose we have defined a simple class, such as: @example -(defclass record () +(defclass my-class () ( ) "Doc String") @end example @@ -636,10 +644,10 @@ Suppose we have a simple class is defined, such as: It is now possible to create objects of that class type. Calling @code{defclass} has defined two new functions. One is the -constructor @var{record}, and the other is the predicate, -@var{record}-p. +constructor @var{my-class}, and the other is the predicate, +@var{my-class}-p. -@defun record object-name &rest slots +@defun my-class object-name &rest slots This creates and returns a new object. This object is not assigned to anything, and will be garbage collected if not saved. This object @@ -657,7 +665,7 @@ can do any valid Lispy thing you want with it, such as Example of creating an object from a class: @example -(record :value 3 :reference nil) +(my-class :value 3 :reference nil) @end example @end defun From 5772971f255c7031753e02492ae979c501018a50 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 9 Apr 2019 18:44:36 -0700 Subject: [PATCH 109/121] Add new defcustom js-jsx-indent-level MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx-indent-level): New variable for users to set JSX indentation differently than JS, like before. (js-jsx--contextual-indentation): Respect js-jsx-indent-level when it’s set. * test/manual/indent/jsx-indent-level.jsx: New test for js-jsx-indent-level. --- lisp/progmodes/js.el | 40 +++++++++++++++++++++++-- test/manual/indent/jsx-indent-level.jsx | 13 ++++++++ 2 files changed, 51 insertions(+), 2 deletions(-) create mode 100644 test/manual/indent/jsx-indent-level.jsx diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 70998245818..90f857c96fa 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -600,6 +600,42 @@ It is set to be buffer-local (and t) when in `js-jsx-mode'." :safe 'booleanp :group 'js) +(defcustom js-jsx-indent-level nil + "When non-nil, indent JSX by this value, instead of like JS. + +Let `js-indent-level' be 4. When this variable is also set to +nil, JSX indentation looks like this (consistent): + + return ( + + + Hello World! + + + ) + +Alternatively, when this variable is also set to 2, JSX +indentation looks like this (different): + + return ( + + + Hello World! + + + )" + :version "27.1" + :type 'integer + :safe (lambda (x) (or (null x) (integerp x))) + :group 'js) +;; This is how indentation behaved out-of-the-box until Emacs 27. JSX +;; indentation was controlled with `sgml-basic-offset', which defaults +;; to 2, whereas `js-indent-level' defaults to 4. Users who had the +;; same values configured for both their HTML and JS indentation would +;; luckily get consistent JSX indentation; most others were probably +;; unhappy. I’d be surprised if anyone actually wants different +;; indentation levels, but just in case, here’s a way back to that. + (defcustom js-jsx-attribute-offset 0 "Specifies a delta for JSXAttribute indentation. @@ -2706,7 +2742,7 @@ The column calculation is based off of `sgml-calculate-indent'." (current-column) ;; This is the first attribute: indent. (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) - (+ (current-column) js-indent-level)))) + (+ (current-column) (or js-jsx-indent-level js-indent-level))))) ('text ;; Indent to reflect nesting. @@ -2715,7 +2751,7 @@ The column calculation is based off of `sgml-calculate-indent'." ;; The last line isn’t nested, but the rest are. (if (or (not (nth 2 context)) ; Unclosed. (< line (line-number-at-pos (nth 2 context)))) - js-indent-level + (or js-jsx-indent-level js-indent-level) 0))) )) diff --git a/test/manual/indent/jsx-indent-level.jsx b/test/manual/indent/jsx-indent-level.jsx new file mode 100644 index 00000000000..0a84b9eb77a --- /dev/null +++ b/test/manual/indent/jsx-indent-level.jsx @@ -0,0 +1,13 @@ +return ( + + + Hello World! + + +) + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 4 +// js-jsx-indent-level: 2 +// End: From c0b09f42f5107dc009629ee73a790ca1d62d290a Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 9 Apr 2019 18:50:28 -0700 Subject: [PATCH 110/121] * etc/NEWS: Document way to revert to old JSX indentation behavior --- etc/NEWS | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 620d88c32a2..81b7d26dc3a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1294,12 +1294,19 @@ conventions. --- *** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. -It was never really intuitive that JSX indentation would be controlled -by an SGML variable. JSX is a syntax extension of JavaScript, so it -should be indented just like any other expression in JavaScript. This -is technically a breaking change, but it will probably align with how -you would normally expect for this indentation to be controlled, and -you probably won't need to change your config. +Since JSX is a syntax extension of JavaScript, it makes the most sense +for JSX expressions to be indented the same number of spaces as other +JS expressions. This is a breaking change, but it probably aligns +with how you'd expect this indentation to behave. If you want JSX to +be indented like JS, you won't need to change your config. + +The old behavior can be emulated by controlling JSX indentation +independently of JS, by setting 'js-jsx-indent-level'. + +--- +*** New defcustom 'js-jsx-indent-level' for different JSX indentation. +If you wish to indent JSX by a different number of spaces than JS, set +this variable to the desired number. --- *** New defcustom 'js-jsx-attribute-offset' for JSX attribute indents. From f29010729f85434ee24efd0d7ed29b7e24cf8be6 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 9 Apr 2019 19:42:49 -0700 Subject: [PATCH 111/121] Add new defcustom js-jsx-align->-with-< MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx-align->-with-<): New variable for users to control one opinionated aspect of JSX indentation. It defaults to the style seen in the React docs, which many users expected as the “correct” indentation. Still, the old SGML-style of indentation could be desirable too, especially since it was the old default. This ensures users have a way of getting back the old behavior. (js-jsx--contextual-indentation): Respect js-jsx-align->-with-<. * test/manual/indent/jsx-align-gt-with-lt.jsx: New test for js-jsx-align->-with-<. --- lisp/progmodes/js.el | 35 ++++++++++++++++++--- test/manual/indent/jsx-align-gt-with-lt.jsx | 12 +++++++ 2 files changed, 43 insertions(+), 4 deletions(-) create mode 100644 test/manual/indent/jsx-align-gt-with-lt.jsx diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 90f857c96fa..afdc28e53b9 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -600,6 +600,31 @@ It is set to be buffer-local (and t) when in `js-jsx-mode'." :safe 'booleanp :group 'js) +(defcustom js-jsx-align->-with-< t + "When non-nil, “>” will be indented to the opening “<” in JSX. + +When this is enabled, JSX indentation looks like this: + + + + + +When this is disabled, JSX indentation looks like this: + + + + " + :version "27.1" + :type 'boolean + :safe 'booleanp + :group 'js) + (defcustom js-jsx-indent-level nil "When non-nil, indent JSX by this value, instead of like JS. @@ -2725,10 +2750,12 @@ The column calculation is based off of `sgml-calculate-indent'." ;; bracket on its own line is indented at the same level as the ;; opening angle bracket of the JSXElement. Otherwise, indent ;; JSXAttribute space like SGML. - (if (progn - (goto-char (nth 2 context)) - (and (= line (line-number-at-pos)) - (looking-back "^\\s-*/?>" (line-beginning-position)))) + (if (and + js-jsx-align->-with-< + (progn + (goto-char (nth 2 context)) + (and (= line (line-number-at-pos)) + (looking-back "^\\s-*/?>" (line-beginning-position))))) (progn (goto-char (nth 1 context)) (current-column)) diff --git a/test/manual/indent/jsx-align-gt-with-lt.jsx b/test/manual/indent/jsx-align-gt-with-lt.jsx new file mode 100644 index 00000000000..8eb1d6d718c --- /dev/null +++ b/test/manual/indent/jsx-align-gt-with-lt.jsx @@ -0,0 +1,12 @@ + + + + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// js-jsx-align->-with-<: nil +// End: From 526ffbad14265addd63db19903a24a9a6073cea6 Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Tue, 9 Apr 2019 19:53:37 -0700 Subject: [PATCH 112/121] * etc/NEWS: Document js-jsx-align->-with-< --- etc/NEWS | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 81b7d26dc3a..fbde6e0b66e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1289,8 +1289,20 @@ wrapped in parenthesis (e.g. in a 'return' statement or a function call). It would also fail in many intricate cases. Now, indentation should work anywhere without parenthesis; many more intricacies are supported; and, indentation conventions align more closely with those -of the React developer community, otherwise still adhering to SGML -conventions. +of the React developer community (see 'js-jsx-align->-with-<'), +otherwise still adhering to SGML conventions. + +--- +*** New defcustom 'js-jsx-align->-with-<' controls '>' indents. +Commonly in JSX code, a '>' on its own line is indented at the same +level as its opening '<'. This is the new default for JSX. This +behavior is slightly different than that used by SGML in Emacs, where +'>' is indented at the same level as attributes, which was also the +old default for JSX. + +This is turned on by default. To get back the old default indentation +behavior of aligning '>' with attributes, set 'js-jsx-align->-with-<' +to nil. --- *** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. From 59994015f194985dbcb7f45a874c7646a223d49e Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Tue, 9 Apr 2019 20:13:47 -0700 Subject: [PATCH 113/121] Note that choose-completion-string-functions funcs take four args * lisp/simple.el (choose-completion-string-functions): Functions in this list actually need to accept four arguments, though the fourth should be ignored. --- lisp/simple.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/simple.el b/lisp/simple.el index 2646d7b0259..a0f2da7152c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8181,6 +8181,9 @@ CHOICE - the string to insert in the buffer, BUFFER - the buffer in which the choice should be inserted, BASE-POSITION - where to insert the completion. +Functions should also accept and ignore a potential fourth +argument, passed for backwards compatibility. + If a function in the list returns non-nil, that function is supposed to have inserted the CHOICE in the BUFFER, and possibly exited the minibuffer; no further functions will be called. From e3bd33fb1cecff290724f0aa2c9eb5feeefbca0c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Apr 2019 10:11:50 -0400 Subject: [PATCH 114/121] Eshell dependencies: Fix recent regressions * lisp/dired.el (dired-insert-directory): Tweak bug#27817's ugly hack. * lisp/eshell/em-ls.el: Refine 'require's. * lisp/eshell/esh-opt.el: Require esh-util on behalf of its clients. --- lisp/dired.el | 4 ++-- lisp/eshell/em-ls.el | 3 ++- lisp/eshell/esh-opt.el | 4 ++++ 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/dired.el b/lisp/dired.el index fc0b71238ba..4c2c3f44e72 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1269,8 +1269,8 @@ If HDR is non-nil, insert a header line with the directory name." ;; as indicated by `ls-lisp-use-insert-directory-program'. (not (and (featurep 'ls-lisp) (null ls-lisp-use-insert-directory-program))) - (not (and (featurep 'eshell) - (bound-and-true-p eshell-ls-use-in-dired))) + ;; FIXME: Big ugly hack for Eshell's eshell-ls-use-in-dired. + (not (bound-and-true-p eshell-ls-use-in-dired)) (or (file-remote-p dir) (if (eq dired-use-ls-dired 'unspecified) ;; Check whether "ls --dired" gives exit code 0, and diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 5e4bbdc87ef..89969d32582 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -29,7 +29,8 @@ (require 'cl-lib) (require 'esh-util) (require 'esh-opt) -(eval-when-compile (require 'eshell)) +(require 'esh-proc) +(require 'esh-cmd) ;;;###autoload (progn diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 5b2693283a7..3ea5873cafd 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -33,6 +33,10 @@ ;;; User Functions: +;; Macro expansion of eshell-eval-using-options refers to eshell-stringify-list +;; defined in esh-util. +(require 'esh-util) + (defmacro eshell-eval-using-options (name macro-args options &rest body-forms) "Process NAME's MACRO-ARGS using a set of command line OPTIONS. After doing so, stores settings in local symbols as declared by OPTIONS; From 0cef057b02b088ded8b46e3453ac0d891888423a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 10 Apr 2019 10:39:50 -0400 Subject: [PATCH 115/121] * test/lisp/progmodes/python-tests.el: "Fix" failing test (python-tests--python-nav-end-of-statement--infloop): Disable. --- test/lisp/progmodes/python-tests.el | 10 ++++++++++ test/src/editfns-tests.el | 3 +++ 2 files changed, 13 insertions(+) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 94c846ecb16..999cf8dc7a3 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5345,13 +5345,23 @@ class SomeClass: (ert-deftest python-tests--python-nav-end-of-statement--infloop () "Checks that `python-nav-end-of-statement' doesn't infloop in a buffer with overlapping strings." + ;; FIXME: The treatment of strings has changed in the mean time, and the + ;; test below now neither signals an error nor inf-loops. + ;; The description of the problem it's trying to catch is not clear enough + ;; to be able to see if the underlying problem is really fixed, sadly. + ;; E.g. I don't know what is meant by "overlap", really. + (skip-unless nil) (python-tests-with-temp-buffer "''' '\n''' ' '\n" (syntax-propertize (point-max)) ;; Create a situation where strings nominally overlap. This ;; shouldn't happen in practice, but apparently it can happen when ;; a package calls `syntax-ppss' in a narrowed buffer during JIT ;; lock. + ;; FIXME: 4-5 is the SPC right after the opening triple quotes: why + ;; put a string-fence syntax on it? (put-text-property 4 5 'syntax-table (string-to-syntax "|")) + ;; FIXME: 8-9 is the middle quote in the closing triple quotes: + ;; it shouldn't have any syntax-table property to remove anyway! (remove-text-properties 8 9 '(syntax-table nil)) (goto-char 4) (setq-local syntax-propertize-function nil) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 449f00f3780..1e8b7066d15 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -351,6 +351,9 @@ "-0x000000003ffffffffffffffe000000000000000 ")))) (ert-deftest test-group-name () + ;; FIXME: Actually my GID in one of my systems has no associated entry + ;; in /etc/group so there's no name for it and `group-name' correctly + ;; returns nil! (should (stringp (group-name (group-gid)))) (should-error (group-name 'foo)) (cond From d2255c6065b0bc3949d494edf8864a2bd13918f3 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 10 Apr 2019 10:06:21 -0700 Subject: [PATCH 116/121] Fix $(MAKE) -C for out-of-tree bootstraps Problem reported by Andy Moreton in: https://lists.gnu.org/r/emacs-devel/2019-04/msg00359.html * src/Makefile.in (${charsets}, $(lispsource)/loaddefs.el): Revert incorrect changes to $(MAKE) -C invocations when the target is in the source tree not the build tree. --- src/Makefile.in | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Makefile.in b/src/Makefile.in index f8a2ffadc27..6d6308fde6d 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -533,7 +533,7 @@ ${lispintdir}/cp51932.el ${lispintdir}/eucjp-ms.el: FORCE charsets = ${top_srcdir}/admin/charsets/charsets.stamp ${charsets}: FORCE - $(MAKE) -C $(dir $@) all + $(MAKE) -C ../admin/charsets all charscript = ${lispintdir}/charscript.el ${charscript}: FORCE @@ -765,7 +765,7 @@ VCSWITNESS = $(lispsource)/loaddefs.el: $(VCSWITNESS) | \ bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) - $(MAKE) -C $(dir $@) autoloads EMACS="$(bootstrap_exe)" + $(MAKE) -C ../lisp autoloads EMACS="$(bootstrap_exe)" ## Dump an Emacs executable named bootstrap-emacs containing the ## files from loadup.el in source form. From 8ecce6af471b4b0cbe022c76e322170914c55e1b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 10 Apr 2019 23:48:13 +0300 Subject: [PATCH 117/121] Inhibit displaying help buffer in main window in perform-replace MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/replace.el (perform-replace): Use display-buffer-overriding-action with inhibit-same-window to prevent the help buffer from being displayed in the main window. (Bug#34972) Author: Michał Krzywkowski Copyright-paperwork-exempt: yes --- lisp/replace.el | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index 318a9fb0253..9d1b7bf747d 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2643,22 +2643,24 @@ characters." (setq def (lookup-key map key)) ;; Restore the match data while we process the command. (cond ((eq def 'help) - (with-output-to-temp-buffer "*Help*" - (princ - (concat "Query replacing " - (if backward "backward " "") - (if delimited-flag - (or (and (symbolp delimited-flag) - (get delimited-flag - 'isearch-message-prefix)) - "word ") "") - (if regexp-flag "regexp " "") - from-string " with " - next-replacement ".\n\n" - (substitute-command-keys - query-replace-help))) - (with-current-buffer standard-output - (help-mode)))) + (let ((display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (with-output-to-temp-buffer "*Help*" + (princ + (concat "Query replacing " + (if backward "backward " "") + (if delimited-flag + (or (and (symbolp delimited-flag) + (get delimited-flag + 'isearch-message-prefix)) + "word ") "") + (if regexp-flag "regexp " "") + from-string " with " + next-replacement ".\n\n" + (substitute-command-keys + query-replace-help))) + (with-current-buffer standard-output + (help-mode))))) ((eq def 'exit) (setq keep-going nil) (setq done t)) From 0627a8d7bc6ffa29d7a503fd36e760778ecb9fa1 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Thu, 11 Apr 2019 00:23:38 +0000 Subject: [PATCH 118/121] Enable message saving to work when first use of Gnus (bug#35208) * lisp/gnus/gnus-group.el (gnus-group-goto-group); Use gnus-active-hashtb in addition to gnus-newsrc-hashtb to check if a group exists since some kinds of groups are registered in only one of them (bug#35208). --- lisp/gnus/gnus-group.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 58f3dc3a6ef..144496bdd2a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2560,7 +2560,11 @@ If FAR, it is likely that the group is not on the current line. If TEST-MARKED, the line must be marked." (when group (let ((start (point)) - (active (and (gethash group gnus-newsrc-hashtb) + (active (and (or + ;; some kind of group may be only there. + (gethash group gnus-active-hashtb) + ;; all groups (but with exception) are there. + (gethash group gnus-newsrc-hashtb)) group))) (beginning-of-line) (cond From 9994bf17cf532f2e1d4310341da7180342202191 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 10 Apr 2019 19:42:37 -0700 Subject: [PATCH 119/121] Bring back dmpstruct.h Bring back the dmpstruct.h checking, and use it when --enable-checking=structs is specified. The checking can be helpful to some developers, although it gets in the way of others and is not needed for ordinary tarball builds. * src/dmpstruct.awk: Restore this file, with mode 644 not 755. * configure.ac: New option-arg --enable-checking=structs, implied by --enable-checking. (CHECK_STRUCTS): New macro and var. * src/Makefile.in (CHECK_STRUCTS): New macro. (dmpstruct_headers, dmpstruct.h, dmpstruct.h): Restore these macros and rules. (pdumper.o): Restore this dependency if $(CHECK_STRUCTS) is true. (mostlyclean): Remove dmpstruct.h. * src/pdumper.c [CHECK_STRUCTS]: Include dmpstruct.h, and restore checks against hashes. --- .gitignore | 1 + configure.ac | 17 ++++++++-- etc/NEWS | 5 +++ src/Makefile.in | 13 +++++++- src/dmpstruct.awk | 45 ++++++++++++++++++++++++++ src/pdumper.c | 81 +++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 159 insertions(+), 3 deletions(-) create mode 100644 src/dmpstruct.awk diff --git a/.gitignore b/.gitignore index 98b8222180b..88b29760b74 100644 --- a/.gitignore +++ b/.gitignore @@ -186,6 +186,7 @@ src/emacs src/emacs-[0-9]* src/temacs src/fingerprint.c +src/dmpstruct.h src/*.pdmp # Character-set info. diff --git a/configure.ac b/configure.ac index c93cfbbb59c..1814a30cbcc 100644 --- a/configure.ac +++ b/configure.ac @@ -537,19 +537,21 @@ fi) AC_ARG_ENABLE(checking, [AS_HELP_STRING([--enable-checking@<:@=LIST@:>@], - [enable expensive run-time checks. With LIST, + [enable expensive checks. With LIST, enable only specific categories of checks. Categories are: all,yes,no. Flags are: stringbytes, stringoverrun, stringfreelist, - xmallocoverrun, conslist, glyphs])], + structs, xmallocoverrun, conslist, glyphs])], [ac_checking_flags="${enableval}"],[]) IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="$IFS," +CHECK_STRUCTS=false for check in $ac_checking_flags do case $check in # these set all the flags to specific states yes) ac_enable_checking=1 ;; no) ac_enable_checking= ; + CHECK_STRUCTS=false ac_gc_check_stringbytes= ; ac_gc_check_string_overrun= ; ac_gc_check_string_free_list= ; @@ -557,6 +559,7 @@ do ac_gc_check_cons_list= ; ac_glyphs_debug= ;; all) ac_enable_checking=1 ; + CHECK_STRUCTS=true ac_gc_check_stringbytes=1 ; ac_gc_check_string_overrun=1 ; ac_gc_check_string_free_list=1 ; @@ -567,6 +570,7 @@ do stringbytes) ac_gc_check_stringbytes=1 ;; stringoverrun) ac_gc_check_string_overrun=1 ;; stringfreelist) ac_gc_check_string_free_list=1 ;; + structs) CHECK_STRUCTS=true ;; xmallocoverrun) ac_xmalloc_overrun=1 ;; conslist) ac_gc_check_cons_list=1 ;; glyphs) ac_glyphs_debug=1 ;; @@ -579,6 +583,15 @@ if test x$ac_enable_checking != x ; then AC_DEFINE(ENABLE_CHECKING, 1, [Define to 1 if expensive run-time data type and consistency checks are enabled.]) fi +if $CHECK_STRUCTS; then + AC_DEFINE([CHECK_STRUCTS], 1, + [Define this to check whether someone updated the portable dumper + code after changing the layout of a structure that it uses. + If you change one of these structures, check that the pdumper.c + code is still valid, and update the pertinent hash in pdumper.c + by manually copying the hash from the newly-generated dmpstruct.h.]) +fi +AC_SUBST([CHECK_STRUCTS]) if test x$ac_gc_check_stringbytes != x ; then AC_DEFINE(GC_CHECK_STRING_BYTES, 1, [Define this temporarily to hunt a bug. If defined, the size of diff --git a/etc/NEWS b/etc/NEWS index fbde6e0b66e..9644c1ca229 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -84,6 +84,11 @@ The new command-line argument '--dump-file=FILE' allows to specify a non-default '.pdmp' file to load the state from; see the node "Initial Options" in the Emacs manual for more information. ++++ +** The new configure option '--enable-checking=structs' attempts to +check that the portable dumper code has been updated to match the last +change to one of the data structures that it relies on. + * Startup Changes in Emacs 27.1 diff --git a/src/Makefile.in b/src/Makefile.in index 6d6308fde6d..2348c8dae4c 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -331,6 +331,7 @@ BUILD_DETAILS = @BUILD_DETAILS@ UNEXEC_OBJ = @UNEXEC_OBJ@ DUMPING=@DUMPING@ +CHECK_STRUCTS = @CHECK_STRUCTS@ # 'make' verbosity. AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ @@ -456,6 +457,16 @@ ALLOBJS = $(FIRSTFILE_OBJ) $(VMLIMIT_OBJ) $(obj) $(otherobj) all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES) .PHONY: all +dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \ + $(srcdir)/intervals.h $(srcdir)/charset.h $(srcdir)/bignum.h +ifeq ($(CHECK_STRUCTS),true) +pdumper.o: dmpstruct.h +endif +dmpstruct.h: $(srcdir)/dmpstruct.awk +dmpstruct.h: $(libsrc)/make-fingerprint$(EXEEXT) $(dmpstruct_headers) + $(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \ + $(dmpstruct_headers) > $@ + AUTO_DEPEND = @AUTO_DEPEND@ DEPDIR = deps ifeq ($(AUTO_DEPEND),yes) @@ -665,7 +676,7 @@ ns-app: emacs$(EXEEXT) $(pdmp) mostlyclean: rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o - rm -f fingerprint.c + rm -f dmpstruct.h fingerprint.c rm -f emacs.pdmp rm -f ../etc/DOC rm -f bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp) diff --git a/src/dmpstruct.awk b/src/dmpstruct.awk new file mode 100644 index 00000000000..55626cf8b21 --- /dev/null +++ b/src/dmpstruct.awk @@ -0,0 +1,45 @@ +# Copyright (C) 2018-2019 Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# GNU Emacs is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or (at +# your option) any later version. +# +# GNU Emacs is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Emacs. If not, see . + +BEGIN { + print "/* Generated by dmpstruct.awk */" + print "#ifndef EMACS_DMPSTRUCT_H" + print "#define EMACS_DMPSTRUCT_H" + struct_name = "" + tmpfile = "dmpstruct.tmp" +} +# Match a type followed by optional syntactic whitespace +/^(enum|struct|union) [a-zA-Z0-9_]+([\t ]|\/\*.*\*\/)*$/ { + struct_name = $2 + close (tmpfile) +} +/^(enum|struct|union) [a-zA-Z0-9_]+([\t ]|\/\*.*\*\/)*$/, /^( )?};$/ { + print $0 > tmpfile +} +/^( )?} *(GCALIGNED_STRUCT)? *;$/ { + if (struct_name != "") { + fflush (tmpfile) + cmd = "../lib-src/make-fingerprint -r " tmpfile + cmd | getline hash + close (cmd) + printf "#define HASH_%s_%.10s\n", struct_name, hash + struct_name = "" + } +} +END { + print "#endif /* EMACS_DMPSTRUCT_H */" +} diff --git a/src/pdumper.c b/src/pdumper.c index 3aa941221db..600c5b3ca3d 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -46,6 +46,10 @@ along with GNU Emacs. If not, see . */ #include "thread.h" #include "bignum.h" +#ifdef CHECK_STRUCTS +# include "dmpstruct.h" +#endif + /* TODO: @@ -2029,6 +2033,9 @@ dump_pseudovector_lisp_fields (struct dump_context *ctx, static dump_off dump_cons (struct dump_context *ctx, const struct Lisp_Cons *cons) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Cons_00EEE63F67) +# error "Lisp_Cons changed. See CHECK_STRUCTS comment." +#endif struct Lisp_Cons out; dump_object_start (ctx, &out, sizeof (out)); dump_field_lv (ctx, &out, cons, &cons->u.s.car, WEIGHT_STRONG); @@ -2041,6 +2048,9 @@ dump_interval_tree (struct dump_context *ctx, INTERVAL tree, dump_off parent_offset) { +#if CHECK_STRUCTS && !defined (HASH_interval_1B38941C37) +# error "interval changed. See CHECK_STRUCTS comment." +#endif /* TODO: output tree breadth-first? */ struct interval out; dump_object_start (ctx, &out, sizeof (out)); @@ -2082,6 +2092,9 @@ dump_interval_tree (struct dump_context *ctx, static dump_off dump_string (struct dump_context *ctx, const struct Lisp_String *string) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_String_86FEA6EC7C) +# error "Lisp_String changed. See CHECK_STRUCTS comment." +#endif /* If we have text properties, write them _after_ the string so that at runtime, the prefetcher and cache will DTRT. (We access the string before its properties.). @@ -2125,6 +2138,10 @@ dump_string (struct dump_context *ctx, const struct Lisp_String *string) static dump_off dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Marker_642DBAF866) +# error "Lisp_Marker changed. See CHECK_STRUCTS comment." +#endif + START_DUMP_PVEC (ctx, &marker->header, struct Lisp_Marker, out); dump_pseudovector_lisp_fields (ctx, &out->header, &marker->header); DUMP_FIELD_COPY (out, marker, need_adjustment); @@ -2144,6 +2161,9 @@ dump_marker (struct dump_context *ctx, const struct Lisp_Marker *marker) static dump_off dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_72EADA9882) +# error "Lisp_Overlay changed. See CHECK_STRUCTS comment." +#endif START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out); dump_pseudovector_lisp_fields (ctx, &out->header, &overlay->header); dump_field_lv_rawptr (ctx, out, overlay, &overlay->next, @@ -2169,6 +2189,9 @@ static dump_off dump_finalizer (struct dump_context *ctx, const struct Lisp_Finalizer *finalizer) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Finalizer_D58E647CB8) +# error "Lisp_Finalizer changed. See CHECK_STRUCTS comment." +#endif START_DUMP_PVEC (ctx, &finalizer->header, struct Lisp_Finalizer, out); /* Do _not_ call dump_pseudovector_lisp_fields here: we dump the only Lisp field, finalizer->function, manually, so we can give it @@ -2188,6 +2211,9 @@ struct bignum_reload_info static dump_off dump_bignum (struct dump_context *ctx, Lisp_Object object) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Bignum_661945DE2B) +# error "Lisp_Bignum changed. See CHECK_STRUCTS comment." +#endif const struct Lisp_Bignum *bignum = XBIGNUM (object); START_DUMP_PVEC (ctx, &bignum->header, struct Lisp_Bignum, out); verify (sizeof (out->value) >= sizeof (struct bignum_reload_info)); @@ -2223,6 +2249,9 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object) static dump_off dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Float_50A7B216D9) +# error "Lisp_Float changed. See CHECK_STRUCTS comment." +#endif eassert (ctx->header.cold_start); struct Lisp_Float out; dump_object_start (ctx, &out, sizeof (out)); @@ -2233,6 +2262,9 @@ dump_float (struct dump_context *ctx, const struct Lisp_Float *lfloat) static dump_off dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd) { +#if CHECK_STRUCTS && !defined HASH_Lisp_Intfwd_4D887A7387 +# error "Lisp_Intfwd changed. See CHECK_STRUCTS comment." +#endif dump_emacs_reloc_immediate_intmax_t (ctx, intfwd->intvar, *intfwd->intvar); struct Lisp_Intfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2244,6 +2276,9 @@ dump_fwd_int (struct dump_context *ctx, const struct Lisp_Intfwd *intfwd) static dump_off dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Boolfwd_0EA1C7ADCC) +# error "Lisp_Boolfwd changed. See CHECK_STRUCTS comment." +#endif dump_emacs_reloc_immediate_bool (ctx, boolfwd->boolvar, *boolfwd->boolvar); struct Lisp_Boolfwd out; dump_object_start (ctx, &out, sizeof (out)); @@ -2255,6 +2290,9 @@ dump_fwd_bool (struct dump_context *ctx, const struct Lisp_Boolfwd *boolfwd) static dump_off dump_fwd_obj (struct dump_context *ctx, const struct Lisp_Objfwd *objfwd) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Objfwd_45D3E513DC) +# error "Lisp_Objfwd changed. See CHECK_STRUCTS comment." +#endif if (NILP (Fgethash (dump_off_to_lisp (emacs_offset (objfwd->objvar)), ctx->staticpro_table, Qnil))) @@ -2270,6 +2308,9 @@ static dump_off dump_fwd_buffer_obj (struct dump_context *ctx, const struct Lisp_Buffer_Objfwd *buffer_objfwd) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Objfwd_13CA6B04FC) +# error "Lisp_Buffer_Objfwd changed. See CHECK_STRUCTS comment." +#endif struct Lisp_Buffer_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, buffer_objfwd, type); @@ -2283,6 +2324,9 @@ static dump_off dump_fwd_kboard_obj (struct dump_context *ctx, const struct Lisp_Kboard_Objfwd *kboard_objfwd) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Kboard_Objfwd_CAA7E71069) +# error "Lisp_Intfwd changed. See CHECK_STRUCTS comment." +#endif struct Lisp_Kboard_Objfwd out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, kboard_objfwd, type); @@ -2293,6 +2337,9 @@ dump_fwd_kboard_obj (struct dump_context *ctx, static dump_off dump_fwd (struct dump_context *ctx, lispfwd fwd) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_Type_9CBA6EE55E) +# error "Lisp_Fwd_Type changed. See CHECK_STRUCTS comment." +#endif void const *p = fwd.fwdptr; dump_off offset; @@ -2324,6 +2371,9 @@ static dump_off dump_blv (struct dump_context *ctx, const struct Lisp_Buffer_Local_Value *blv) { +#if CHECK_STRUCTS && !defined HASH_Lisp_Buffer_Local_Value_3C363FAC3C +# error "Lisp_Buffer_Local_Value changed. See CHECK_STRUCTS comment." +#endif struct Lisp_Buffer_Local_Value out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, blv, local_if_set); @@ -2386,6 +2436,13 @@ dump_symbol (struct dump_context *ctx, Lisp_Object object, dump_off offset) { +#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC +# error "Lisp_Symbol changed. See CHECK_STRUCTS comment." +#endif +#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113) +# error "symbol_redirect changed. See CHECK_STRUCTS comment." +#endif + if (ctx->flags.defer_symbols) { if (offset != DUMP_OBJECT_ON_SYMBOL_QUEUE) @@ -2475,6 +2532,9 @@ static dump_off dump_vectorlike_generic (struct dump_context *ctx, const union vectorlike_header *header) { +#if CHECK_STRUCTS && !defined (HASH_vectorlike_header_00A5A4BFB2) +# error "vectorlike_header changed. See CHECK_STRUCTS comment." +#endif const struct Lisp_Vector *v = (const struct Lisp_Vector *) header; ptrdiff_t size = header->size; enum pvec_type pvectype = PSEUDOVECTOR_TYPE (v); @@ -2632,6 +2692,9 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object, dump_off offset) { +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_EF95ED06FF +# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment." +#endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); bool is_stable = dump_hash_table_stable_p (hash_in); /* If the hash table is likely to be modified in memory (either @@ -2697,6 +2760,9 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { +#if CHECK_STRUCTS && !defined HASH_buffer_E34A11C6B9 +# error "buffer changed. See CHECK_STRUCTS comment." +#endif struct buffer munged_buffer = *in_buffer; struct buffer *buffer = &munged_buffer; @@ -2830,6 +2896,9 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) static dump_off dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Vector_3091289B35) +# error "Lisp_Vector changed. See CHECK_STRUCTS comment." +#endif /* No relocation needed, so we don't need dump_object_start. */ dump_align_output (ctx, DUMP_ALIGNMENT); eassert (ctx->offset >= ctx->header.cold_start); @@ -2844,6 +2913,9 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_594AB72B54) +# error "Lisp_Subr changed. See CHECK_STRUCTS comment." +#endif struct Lisp_Subr out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, subr, header.size); @@ -2880,6 +2952,9 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { +#if CHECK_STRUCTS && !defined (HASH_pvec_type_549C833A54) +# error "pvec_type changed. See CHECK_STRUCTS comment." +#endif const struct Lisp_Vector *v = XVECTOR (lv); switch (PSEUDOVECTOR_TYPE (v)) { @@ -2987,6 +3062,9 @@ dump_vectorlike (struct dump_context *ctx, static dump_off dump_object (struct dump_context *ctx, Lisp_Object object) { +#if CHECK_STRUCTS && !defined (HASH_Lisp_Type_E2AD97D3F7) +# error "Lisp_Type changed. See CHECK_STRUCTS comment." +#endif #ifdef ENABLE_CHECKING /* Vdead is extern only when ENABLE_CHECKING. */ eassert (!EQ (object, Vdead)); @@ -3089,6 +3167,9 @@ dump_object_for_offset (struct dump_context *ctx, Lisp_Object object) static dump_off dump_charset (struct dump_context *ctx, int cs_i) { +#if CHECK_STRUCTS && !defined (HASH_charset_317C49E291) +# error "charset changed. See CHECK_STRUCTS comment." +#endif dump_align_output (ctx, alignof (int)); const struct charset *cs = charset_table + cs_i; struct charset out; From 382a508ed21e4f12ace9f8871818e25235e8f05e Mon Sep 17 00:00:00 2001 From: Jackson Ray Hamilton Date: Wed, 10 Apr 2019 22:53:34 -0700 Subject: [PATCH 120/121] Add extra text property to fix issue with js2-mode integration MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/js.el (js-jsx--put-syntax-table): New function for consistently ensuring smooth js2-mode integration. js2-mode sets syntax-table temporarily while parsing buffers—seemingly to recover from parsing interruptions—and then it later clears syntax-table blindly. When integrating with js-mode, this means that unterminated string quotes are re-broken in JSX (i.e., they become strings again, often stringifying large regions of the buffer which should not be strings). We try to treat quotes in JSXText as non-strings by setting syntax-table to a non-“string quote” syntax class, but that stops working if we lose the property. On the js2-mode end, by scanning for this second js-jsx-syntax-table property, we can recover the syntax-table property there. (js-jsx--text-range, js-jsx--syntax-propertize-tag): Use js-jsx--put-syntax-table for above reason. (js-jsx--text-properties): Clear the js-jsx-syntax-table property too. --- lisp/progmodes/js.el | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index afdc28e53b9..a0adaa84eeb 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2140,6 +2140,14 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." ;; `syntax-propertize-rules' loop so the next JSXBoundaryElement can ;; be parsed, if any, be it an opening or closing one. +(defun js-jsx--put-syntax-table (start end value) + "Set syntax-table text property from START to END as VALUE. +Redundantly set the value to two properties, syntax-table and +js-jsx-syntax-table. Derivative modes that remove syntax-table +text properties may recover the value from the second property." ; i.e. js2-mode + (add-text-properties start end (list 'syntax-table value + 'js-jsx-syntax-table value))) + (defun js-jsx--text-range (beg end) "Identify JSXText within a “>/{/}/<” pair." (when (> (- end beg) 0) @@ -2151,7 +2159,7 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." ;; negate those roles. (when (or (= (char-after) ?/) ; comment (= (syntax-class (syntax-after (point))) 7)) ; string quote - (put-text-property (point) (1+ (point)) 'syntax-table '(1))) + (js-jsx--put-syntax-table (point) (1+ (point)) '(1))) (forward-char))) ;; Mark JSXText so it can be font-locked as non-keywords. (put-text-property beg (1+ beg) 'js-jsx-text (list beg end (current-buffer))) @@ -2220,7 +2228,7 @@ testing for syntax only valid as JSX." (cond ((= (char-after) ?>) ;; Make the closing “>” a close parenthesis. - (put-text-property (point) (1+ (point)) 'syntax-table '(5)) + (js-jsx--put-syntax-table (point) (1+ (point)) '(5)) (forward-char) (setq unambiguous t) (throw 'stop nil)) @@ -2306,7 +2314,7 @@ testing for syntax only valid as JSX." ;; Save JSXBoundaryElement’s name’s match data for font-locking. (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) ;; Make the opening “<” an open parenthesis. - (put-text-property tag-beg (1+ tag-beg) 'syntax-table '(4)) + (js-jsx--put-syntax-table tag-beg (1+ tag-beg) '(4)) ;; Prevent “out of range” errors when typing at the end of a buffer. (setq tag-end (if (eobp) (1- (point)) (point))) ;; Mark beginning and end of tag for font-locking. @@ -2325,7 +2333,8 @@ testing for syntax only valid as JSX." (list 'js-jsx-tag-beg nil 'js-jsx-tag-end nil 'js-jsx-close-tag-pos nil 'js-jsx-tag-name nil 'js-jsx-attribute-name nil 'js-jsx-string nil - 'js-jsx-text nil 'js-jsx-expr nil 'js-jsx-expr-attribute nil) + 'js-jsx-text nil 'js-jsx-expr nil 'js-jsx-expr-attribute nil + 'js-jsx-syntax-table nil) "Plist of text properties added by `js-syntax-propertize'.") (defun js-syntax-propertize (start end) From de238b39e335c6814283faa171b35145f124edf2 Mon Sep 17 00:00:00 2001 From: Christopher Thorne Date: Thu, 11 Apr 2019 23:51:13 +0300 Subject: [PATCH 121/121] Fix rgrep in dired using directory for search file pattern * lisp/progmodes/grep.el (grep-read-files): Allow major modes to define file name to use for default search pattern. Add non-directory file at point as default search pattern candidate. * lisp/dired.el (dired-grep-read-files): Use non-directory file at point for grep file name pattern. (Bug#34621) Copyright-paperwork-exempt: yes --- lisp/dired.el | 9 +++++++++ lisp/progmodes/grep.el | 12 ++++++++++-- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/lisp/dired.el b/lisp/dired.el index 4c2c3f44e72..63082fe3927 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -774,6 +774,15 @@ as an argument to `dired-goto-file'." (file-name-as-directory (abbreviate-file-name filename)) (abbreviate-file-name filename))))) +(defun dired-grep-read-files () + "Use file at point as the file for grep's default file-name pattern suggestion. +If a directory or nothing is found at point, return nil." + (let ((file-name (dired-file-name-at-point))) + (if (and file-name + (not (file-directory-p file-name))) + file-name))) +(put 'dired-mode 'grep-read-files 'dired-grep-read-files) + ;;;###autoload (define-key ctl-x-map "d" 'dired) ;;;###autoload (defun dired (dirname &optional switches) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index c0f47159c95..8c7a58fd8bd 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -959,8 +959,16 @@ substitution string. Note dynamic scoping of variables.") The pattern can include shell wildcards. As whitespace triggers completion when entering a pattern, including it requires quoting, e.g. `\\[quoted-insert]'." - (let* ((bn (or (buffer-file-name) - (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))) + (let* ((grep-read-files-function (get major-mode 'grep-read-files)) + (file-name-at-point + (run-hook-with-args-until-success 'file-name-at-point-functions)) + (bn (if grep-read-files-function + (funcall grep-read-files-function) + (or (if (and (stringp file-name-at-point) + (not (file-directory-p file-name-at-point))) + file-name-at-point) + (buffer-file-name) + (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name))))) (fn (and bn (stringp bn) (file-name-nondirectory bn)))