commit 5940ac63300c71b983b173c99c718920c179cbf8 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Sep 13 10:47:28 2019 +0300 Fix assertion violations due to non-ASCII text in menus * src/xdisp.c (tool_bar_height, redisplay_tool_bar) (display_menu_bar): If the Lisp string to be displayed in the menu-bar or tool-bar window is multibyte, tell the display engine to treat it as multibyte, instead of relying on the initial determination by init_iterator (which is based on the multibyteness of the current buffer). (Bug#37385) diff --git a/src/xdisp.c b/src/xdisp.c index 94f969f37c..6626fbcf63 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12907,7 +12907,8 @@ tool_bar_height (struct frame *f, int *n_rows, bool pixelwise) temp_row->reversed_p = false; it.first_visible_x = 0; it.last_visible_x = WINDOW_PIXEL_WIDTH (w); - reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); + reseat_to_string (&it, NULL, f->desired_tool_bar_string, + 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string)); it.paragraph_embedding = L2R; while (!ITERATOR_AT_END_P (&it)) @@ -12994,7 +12995,8 @@ redisplay_tool_bar (struct frame *f) /* Build a string that represents the contents of the tool-bar. */ build_desired_tool_bar_string (f); - reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); + reseat_to_string (&it, NULL, f->desired_tool_bar_string, + 0, 0, 0, STRING_MULTIBYTE (f->desired_tool_bar_string)); /* FIXME: This should be controlled by a user option. But it doesn't make sense to have an R2L tool bar if the menu bar cannot be drawn also R2L, and making the menu bar R2L is tricky due @@ -23531,7 +23533,7 @@ display_menu_bar (struct window *w) /* Display the item, pad with one space. */ if (it.current_x < it.last_visible_x) display_string (NULL, string, Qnil, 0, 0, &it, - SCHARS (string) + 1, 0, 0, -1); + SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string)); } /* Fill out the line with spaces. */ commit a4c471c98474a249948793aad386e4efc64a1c96 Author: Jack Coughlin Date: Thu Jul 18 08:16:50 2019 -0700 Fix saving user-defined calc commands with compositions (Bug#36720) * lisp/calc/calc-prog.el (calc-user-define-permanent): Correctly save the composition when the user specifies their formula by its command name or key. Copyright-paperwork-exempt: yes diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index ba8efd43b8..37e10e8dfa 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1097,7 +1097,7 @@ Redefine the corresponding command." (or func (setq func (and cmd (symbolp cmd) (fboundp cmd) cmd))) (if (get func 'math-compose-forms) (let ((pt (point))) - (insert "(put '" (symbol-name cmd) + (insert "(put '" (symbol-name func) " 'math-compose-forms '" (prin1-to-string (get func 'math-compose-forms)) ")\n") commit cbb8a8ad979ed7975bfc7e9fa6aeeb4d9d6b7084 Author: Noam Postavsky Date: Sun Sep 8 10:42:19 2019 -0400 Fix fill-paragraph in python docstrings (Bug#36056) * lisp/progmodes/python.el (python-do-auto-fill): New function. (python-mode): Set it as normal-auto-fill-function, and don't set fill-indent-according-to-mode. Having the latter set during fill-paragraph gives wrongs result, because python-indent-line doesn't remove indentation added by filling. * test/lisp/progmodes/python-tests.el (python-fill-docstring): New test. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 14b65669c4..ec5d8c5551 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4084,6 +4084,12 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (goto-char (line-end-position)))) t) +(defun python-do-auto-fill () + "Like `do-auto-fill', but bind `fill-indent-according-to-mode'." + ;; See Bug#36056. + (let ((fill-indent-according-to-mode t)) + (do-auto-fill))) + ;;; Skeletons @@ -5379,7 +5385,7 @@ REPORT-FN is Flymake's callback function." (set (make-local-variable 'paragraph-start) "\\s-*$") (set (make-local-variable 'fill-paragraph-function) #'python-fill-paragraph) - (set (make-local-variable 'fill-indent-according-to-mode) t) ; Bug#36056. + (set (make-local-variable 'normal-auto-fill-function) #'python-do-auto-fill) (set (make-local-variable 'beginning-of-defun-function) #'python-nav-beginning-of-defun) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index b1cf7e8806..c5ad1dfb86 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -1351,7 +1351,7 @@ this is an arbitrarily expected))))) -;;; Autofill +;;; Filling (ert-deftest python-auto-fill-docstring () (python-tests-with-temp-buffer @@ -1368,6 +1368,17 @@ def some_function(arg1, (forward-line 1) (should (= docindent (current-indentation)))))) +(ert-deftest python-fill-docstring () + (python-tests-with-temp-buffer + "\ +r'''aaa + +this is a test this is a test this is a test this is a test this is a test this is a test. +'''" + (search-forward "test.") + (fill-paragraph) + (should (= (current-indentation) 0)))) + ;;; Mark commit 421084d2cb160261b259bddb687bb2c234f8f1ef Author: Stefan Monnier Date: Thu Sep 12 15:43:50 2019 -0400 * lisp/progmodes/sh-script.el (sh--assignment-collect): Only after `=`! diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 230789eb6c..cbc0ac74f0 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -4338,12 +4338,13 @@ option followed by a colon `:' if the option accepts an argument." (defun sh--assignment-collect () (sh-remember-variable - (save-excursion - (if (re-search-forward (sh-feature sh-assignment-regexp) - (prog1 (point) - (beginning-of-line 1)) - t) - (match-string 1))))) + (when (eq ?= (char-before)) + (save-excursion + (if (re-search-forward (sh-feature sh-assignment-regexp) + (prog1 (point) + (beginning-of-line 1)) + t) + (match-string 1)))))) (defun sh-maybe-here-document (arg) commit 7fbabaf96ab55437b42e6365885c9c780726594c Author: Stefan Monnier Date: Thu Sep 12 14:26:40 2019 -0400 * lisp/progmodes/sh-script.el (sh-mode-map): Don't bind `=` (sh-shell-initialize-variables): Use sh--assignment-collect on post-self-insert-hook instead. (sh--assignment-collect): New function, extracted from sh-assignment. (sh-assignment): Use it and mark as obsolete. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index aad38b94d7..230789eb6c 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -112,7 +112,7 @@ ;; would make this unnecessary; simply learn the values when you visit ;; the buffer. ;; You can do this automatically like this: -;; (add-hook 'sh-set-shell-hook 'sh-learn-buffer-indent) +;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent) ;; ;; However... `sh-learn-buffer-indent' is extremely slow, ;; especially on large-ish buffer. Also, if there are conflicts the @@ -480,7 +480,6 @@ This is buffer-local in every such buffer.") (define-key map "\C-c>" 'sh-learn-buffer-indent) (define-key map "\C-c\C-\\" 'sh-backslash-region) - (define-key map "=" 'sh-assignment) (define-key map "\C-c+" 'sh-add) (define-key map "\C-\M-x" 'sh-execute-region) (define-key map "\C-c\C-x" 'executable-interpret) @@ -1059,7 +1058,7 @@ subshells can nest." (when (< startpos (line-beginning-position)) (put-text-property startpos (point) 'syntax-multiline t) (add-hook 'syntax-propertize-extend-region-functions - 'syntax-propertize-multiline nil t)) + #'syntax-propertize-multiline nil t)) ))) @@ -1603,25 +1602,25 @@ with your script for an edit-interpret-debug cycle." (setq-local local-abbrev-table sh-mode-abbrev-table) (setq-local comint-dynamic-complete-functions sh-dynamic-complete-functions) - (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t) + (add-hook 'completion-at-point-functions #'comint-completion-at-point nil t) ;; we can't look if previous line ended with `\' (setq-local comint-prompt-regexp "^[ \t]*") (setq-local imenu-case-fold-search nil) (setq font-lock-defaults - '((sh-font-lock-keywords + `((sh-font-lock-keywords sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil (font-lock-syntactic-face-function - . sh-font-lock-syntactic-face-function))) + . ,#'sh-font-lock-syntactic-face-function))) (setq-local syntax-propertize-function #'sh-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) (setq-local skeleton-pair-alist '((?` _ ?`))) - (setq-local skeleton-pair-filter-function 'sh-quoted-p) + (setq-local skeleton-pair-filter-function #'sh-quoted-p) (setq-local skeleton-further-elements '((< '(- (min sh-basic-offset (current-column)))))) - (setq-local skeleton-filter-function 'sh-feature) + (setq-local skeleton-filter-function #'sh-feature) (setq-local skeleton-newline-indent-rigidly t) (setq-local defun-prompt-regexp (concat @@ -2408,12 +2407,12 @@ whose value is the shell name (don't quote it)." (message "setting up indent stuff") ;; sh-mode has already made indent-line-function local ;; but do it in case this is called before that. - (setq-local indent-line-function 'sh-indent-line)) + (setq-local indent-line-function #'sh-indent-line)) (if sh-make-vars-local (sh-make-vars-local)) (message "Indentation setup for shell type %s" sh-shell)) (message "No indentation for this shell type.") - (setq-local indent-line-function 'sh-basic-indent-line)) + (setq-local indent-line-function #'sh-basic-indent-line)) (when font-lock-mode (setq font-lock-set-defaults nil) (font-lock-set-defaults) @@ -3586,7 +3585,7 @@ so that `occur-next' and `occur-prev' will work." ;; (insert ")\n") ;; ))) ;; -;; (add-hook 'sh-learned-buffer-hook 'what-i-learned) +;; (add-hook 'sh-learned-buffer-hook #'what-i-learned) ;; Originally this was sh-learn-region-indent (beg end) @@ -4055,7 +4054,8 @@ Add these variables to `sh-shell-variables'." (goto-char (point-min)) (setq sh-shell-variables-initialized t) (while (search-forward "=" nil t) - (sh-assignment 0))) + (sh--assignment-collect))) + (add-hook 'post-self-insert-hook #'sh--assignment-collect nil t) (message "Scanning buffer `%s' for variable assignments...done" (buffer-name))) @@ -4328,20 +4328,23 @@ option followed by a colon `:' if the option accepts an argument." +(put 'sh-assignment 'delete-selection t) (defun sh-assignment (arg) "Remember preceding identifier for future completion and do self-insert." (interactive "p") + (declare (obsolete nil "27.1")) (self-insert-command arg) - (if (<= arg 1) - (sh-remember-variable - (save-excursion - (if (re-search-forward (sh-feature sh-assignment-regexp) - (prog1 (point) - (beginning-of-line 1)) - t) - (match-string 1)))))) + (sh--assignment-collect)) + +(defun sh--assignment-collect () + (sh-remember-variable + (save-excursion + (if (re-search-forward (sh-feature sh-assignment-regexp) + (prog1 (point) + (beginning-of-line 1)) + t) + (match-string 1))))) -(put 'sh-assignment 'delete-selection t) (defun sh-maybe-here-document (arg) "Insert self. Without prefix, following unquoted `<' inserts here document. commit bbadc6e05f4321466fe8bcd91df6b65fbc6c7d69 Author: Karl Fogel Date: Thu Sep 12 12:42:13 2019 -0500 Add `isearch-yank-until-char' * lisp/isearch.el (isearch-yank-until-char): New function. (isearch-mode-map, isearch-menu-bar-yank-map): Add it. (isearch-forward): Document the new binding. * doc/emacs/search.texi (Isearch Yanking): Document the feature. * etc/NEWS: Mention the above. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 66af5d4016..38ef49ed64 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -262,11 +262,19 @@ of whether to copy a character or a symbol is heuristic.) @kindex M-s C-e @r{(Incremental search)} @findex isearch-yank-line - Similarly, @kbd{M-s C-e} (@code{isearch-yank-line}) appends the rest + @kbd{M-s C-e} (@code{isearch-yank-line}) appends the rest of the current line to the search string. If point is already at the end of a line, it appends the next line. With a prefix argument @var{n}, it appends the next @var{n} lines. +@kindex C-M-z @r{(Incremental search)} +@findex isearch-yank-until-char + Similarly, @kbd{C-M-z} (@code{isearch-yank-until-char}) appends to +the search string everything from point until the next occurence of +a specified character (not including that character). This is especially +useful for keyboard macros, for example in programming languages or +markup languages in which that character marks a token boundary. + @kindex C-y @r{(Incremental search)} @kindex M-y @r{(Incremental search)} @kindex mouse-2 @r{in the minibuffer (Incremental search)} diff --git a/etc/NEWS b/etc/NEWS index 87666740df..1bde9c442b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1255,6 +1255,11 @@ highlight in one iteration while processing the full buffer. +++ *** New isearch bindings. +'C-M-z' invokes new function 'isearch-yank-until-char', which yanks +everything from point up to but not including the specified +character into the search string. This is especially useful for +keyboard macros. + 'C-M-w' in isearch changed from 'isearch-del-char' to the new function 'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to 'C-M-d'. diff --git a/lisp/isearch.el b/lisp/isearch.el index 30f7fc7254..9401e8c06d 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -514,6 +514,9 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map [isearch-yank-kill] '(menu-item "Current kill" isearch-yank-kill :help "Append current kill to search string")) + (define-key map [isearch-yank-until-char] + '(menu-item "Until char..." isearch-yank-until-char + :help "Yank from point to specified character into search string")) (define-key map [isearch-yank-line] '(menu-item "Rest of line" isearch-yank-line :help "Yank the rest of the current line on search string")) @@ -705,6 +708,7 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-\C-d" 'isearch-del-char) (define-key map "\M-\C-y" 'isearch-yank-char) (define-key map "\C-y" 'isearch-yank-kill) + (define-key map "\M-\C-z" 'isearch-yank-until-char) (define-key map "\M-s\C-e" 'isearch-yank-line) (define-key map "\M-s\M-<" 'isearch-beginning-of-buffer) @@ -998,6 +1002,8 @@ Type \\[isearch-yank-word-or-char] to yank next word or character in buffer Type \\[isearch-del-char] to delete character from end of search string. Type \\[isearch-yank-char] to yank char from buffer onto end of search\ string and search for it. +Type \\[isearch-yank-until-char] to yank from point until the next instance of a + specified character onto end of search string and search for it. Type \\[isearch-yank-line] to yank rest of line onto end of search string\ and search for it. Type \\[isearch-yank-kill] to yank the last string of killed text. @@ -2562,6 +2568,23 @@ If optional ARG is non-nil, pull in the next ARG words." (interactive "p") (isearch-yank-internal (lambda () (forward-word arg) (point)))) +(defun isearch-yank-until-char (char) + "Pull everything until next instance of CHAR from buffer into search string. +Interactively, prompt for CHAR. +This is often useful for keyboard macros, for example in programming +languages or markup languages in which CHAR marks a token boundary." + (interactive "cYank until character: ") + (isearch-yank-internal + (lambda () (let ((inhibit-field-text-motion t)) + (condition-case nil + (progn + (search-forward (char-to-string char)) + (forward-char -1)) + (search-failed + (message "`%c' not found" char) + (sit-for 2))) + (point))))) + (defun isearch-yank-line (&optional arg) "Pull rest of line from buffer into search string. If optional ARG is non-nil, yank the next ARG lines." commit 5e8d477d63496ada8eb2c42d23735df0cf05ee2d Author: Michael Albinus Date: Thu Sep 12 16:38:48 2019 +0200 Optimize host name completion in Tramp * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection): Throw `non-essential' at the beginning of the function. * lisp/net/tramp.el (tramp-handle-file-exists-p): * lisp/net/tramp-sh.el (tramp-sh-handle-file-exists-p): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-exists-p): Run only when host is connectable. This is due to host name completion, which shall be optimized. * lisp/net/tramp-smb.el (tramp-smb-do-file-attributes-with-stat) (tramp-smb-get-file-entries): Access connection buffer only after sending the command. * lisp/net/tramp.el (tramp-get-buffer, tramp-get-connection-buffer): New argument DONT-CREATE. (tramp-message): Use it. (tramp-get-mutex): Check, whether host is connectable. (tramp-file-name-handler): Set thread only when host is connectable. (tramp-connectable-p): Allow also VEC as argument. (tramp-completion-handle-file-name-completion): Do not expand directory. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index df4778c9c9..982522bdaf 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1191,6 +1191,10 @@ FMT and ARGS are passed to `error'." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let* ((buf (tramp-get-connection-buffer vec)) (p (get-buffer-process buf)) (host (tramp-file-name-host vec)) @@ -1204,14 +1208,6 @@ connection if a previous connection has died for some reason." (tramp-error vec 'file-error "Cannot switch to user `%s'" user)) (unless (process-live-p p) - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; - ;; otherwise `start-file-process' wouldn't run ever when - ;; `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (save-match-data (when (and p (processp p)) (delete-process p)) (if (zerop (length device)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index b9b6b4b6d1..1036865e4e 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1787,6 +1787,10 @@ This is relevant for GNOME Online Accounts." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + ;; We set the file name, in case there are incoming D-Bus signals or ;; D-Bus errors. (setq tramp-gvfs-dbus-event-vector vec) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 866e7791bf..1f0c7eadbc 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -520,19 +520,14 @@ file names." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let ((host (tramp-file-name-host vec))) (when (rassoc `(,host) (tramp-rclone-parse-device-names nil)) (if (zerop (length host)) (tramp-error vec 'file-error "Storage %s not connected" host)) - - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; - ;; otherwise `start-file-process' wouldn't run ever when - ;; `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - ;; We need a process bound to the connection buffer. Therefore, ;; we create a dummy process. Maybe there is a better solution? (unless (get-buffer-process (tramp-get-connection-buffer vec)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index bcfac78ee6..4bc37f0169 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1198,18 +1198,22 @@ component is used as the target of the symlink." (defun tramp-sh-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-exists-p" - (or (not (null (tramp-get-file-property - v localname "file-attributes-integer" nil))) - (not (null (tramp-get-file-property - v localname "file-attributes-string" nil))) - (tramp-send-command-and-check - v - (format - "%s %s" - (tramp-get-file-exists-command v) - (tramp-shell-quote-argument localname))))))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-exists-p" + (or (not (null (tramp-get-file-property + v localname "file-attributes-integer" nil))) + (not (null (tramp-get-file-property + v localname "file-attributes-string" nil))) + (tramp-send-command-and-check + v + (format + "%s %s" + (tramp-get-file-exists-command v) + (tramp-shell-quote-argument localname)))))))) (defun tramp-sh-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." @@ -4762,6 +4766,10 @@ If there is just some editing, retry it after 5 seconds." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let ((p (tramp-get-connection-process vec)) (process-name (tramp-get-connection-property vec "process-name" nil)) (process-environment (copy-sequence process-environment)) @@ -4806,15 +4814,6 @@ connection if a previous connection has died for some reason." ;; New connection must be opened. (condition-case err (unless (process-live-p p) - - ;; During completion, don't reopen a new connection. We - ;; check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (with-tramp-progress-reporter vec 3 (if (zerop (length (tramp-file-name-user vec))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 5df26a1e33..b008e6b25e 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -832,12 +832,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Implement `file-attributes' for Tramp files using stat command." (tramp-message vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) - (with-current-buffer (tramp-get-connection-buffer vec) - (let* (size id link uid gid atime mtime ctime mode inode) - (when (tramp-smb-send-command - vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) + (let* (size id link uid gid atime mtime ctime mode inode) + (when (tramp-smb-send-command + vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) - ;; Loop the listing. + ;; Loop the listing. + (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) (unless (re-search-forward tramp-smb-errors nil t) (while (not (eobp)) @@ -1628,40 +1628,40 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (with-parsed-tramp-file-name (file-name-as-directory directory) nil (setq localname (or localname "/")) (with-tramp-file-property v localname "file-entries" - (with-current-buffer (tramp-get-connection-buffer v) - (let* ((share (tramp-smb-get-share v)) - (cache (tramp-get-connection-property v "share-cache" nil)) - res entry) - - (if (and (not share) cache) - ;; Return cached shares. - (setq res cache) - - ;; Read entries. - (if share - (tramp-smb-send-command - v (format "dir \"%s*\"" (tramp-smb-get-localname v))) - ;; `tramp-smb-maybe-open-connection' lists also the share names. - (tramp-smb-maybe-open-connection v)) - - ;; Loop the listing. + (let* ((share (tramp-smb-get-share v)) + (cache (tramp-get-connection-property v "share-cache" nil)) + res entry) + + (if (and (not share) cache) + ;; Return cached shares. + (setq res cache) + + ;; Read entries. + (if share + (tramp-smb-send-command + v (format "dir \"%s*\"" (tramp-smb-get-localname v))) + ;; `tramp-smb-maybe-open-connection' lists also the share names. + (tramp-smb-maybe-open-connection v)) + + ;; Loop the listing. + (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (if (re-search-forward tramp-smb-errors nil t) (tramp-error v 'file-error "%s `%s'" (match-string 0) directory) (while (not (eobp)) (setq entry (tramp-smb-read-file-entry share)) (forward-line) - (when entry (push entry res)))) + (when entry (push entry res))))) - ;; Cache share entries. - (unless share - (tramp-set-connection-property v "share-cache" res))) + ;; Cache share entries. + (unless share + (tramp-set-connection-property v "share-cache" res))) - ;; Add directory itself. - (push '("" "drwxrwxrwx" 0 (0 0)) res) + ;; Add directory itself. + (push '("" "drwxrwxrwx" 0 (0 0)) res) - ;; Return entries. - (delq nil res)))))) + ;; Return entries. + (delq nil res))))) ;; Return either a share name (if SHARE is nil), or a file name. ;; @@ -1855,6 +1855,10 @@ Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason. If ARGUMENT is non-nil, use it as argument for `tramp-smb-winexe-program', and suppress any checks." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + (let* ((share (tramp-smb-get-share vec)) (buf (tramp-get-connection-buffer vec)) (p (get-buffer-process buf))) @@ -1909,15 +1913,6 @@ If ARGUMENT is non-nil, use it as argument for (string-equal share (tramp-get-connection-property p "smb-share" "")))) - - ;; During completion, don't reopen a new connection. We - ;; check this for the process related to - ;; `tramp-buffer-name'; otherwise `start-file-process' - ;; wouldn't run ever when `non-essential' is non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (save-match-data ;; There might be unread output from checking for share names. (when buf (with-current-buffer buf (erase-buffer))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 80ce8f7874..bfc9b3bdc3 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -424,10 +424,14 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-exists-p" - (tramp-sudoedit-send-command - v "test" "-e" (tramp-compat-file-name-unquote localname))))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-exists-p" + (tramp-sudoedit-send-command + v "test" "-e" (tramp-compat-file-name-unquote localname)))))) (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -760,18 +764,13 @@ Remove unneeded output." "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." + ;; During completion, don't reopen a new connection. + (unless (tramp-connectable-p vec) + (throw 'non-essential 'non-essential)) + ;; We need a process bound to the connection buffer. Therefore, we ;; create a dummy process. Maybe there is a better solution? (unless (tramp-get-connection-process vec) - - ;; During completion, don't reopen a new connection. We check - ;; this for the process related to `tramp-buffer-name'; otherwise - ;; `start-file-process' wouldn't run ever when `non-essential' is - ;; non-nil. - (when (and (tramp-completion-mode-p) - (null (get-process (tramp-buffer-name vec)))) - (throw 'non-essential 'non-essential)) - (let ((p (make-network-process :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ed0f1def18..8903d38d20 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1566,25 +1566,27 @@ necessary only. This function will be used in file name completion." tramp-postfix-host-format)) (when localname localname))) -(defun tramp-get-buffer (vec) +(defun tramp-get-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC." (or (get-buffer (tramp-buffer-name vec)) - (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) - ;; We use the existence of connection property "process-buffer" - ;; as indication, whether a connection is active. - (tramp-set-connection-property - vec "process-buffer" - (tramp-get-connection-property vec "process-buffer" nil)) - (setq buffer-undo-list t - default-directory (tramp-make-tramp-file-name vec 'noloc 'nohop)) - (current-buffer)))) - -(defun tramp-get-connection-buffer (vec) + (unless dont-create + (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) + ;; We use the existence of connection property "process-buffer" + ;; as indication, whether a connection is active. + (tramp-set-connection-property + vec "process-buffer" + (tramp-get-connection-property vec "process-buffer" nil)) + (setq buffer-undo-list t + default-directory + (tramp-make-tramp-file-name vec 'noloc 'nohop)) + (current-buffer))))) + +(defun tramp-get-connection-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC. In case a second asynchronous communication has been started, it is different from `tramp-get-buffer'." (or (tramp-get-connection-property vec "process-buffer" nil) - (tramp-get-buffer vec))) + (tramp-get-buffer vec dont-create))) (defun tramp-get-connection-name (vec) "Get the connection name to be used for VEC. @@ -1770,14 +1772,15 @@ applicable)." ;; Log only when there is a minimum level. (when (>= tramp-verbose 4) (let ((tramp-verbose 0)) - ;; Append connection buffer for error messages. + ;; Append connection buffer for error messages, if exists. (when (= level 1) - (with-current-buffer - (if (processp vec-or-proc) - (process-buffer vec-or-proc) - (tramp-get-connection-buffer vec-or-proc)) - (setq fmt-string (concat fmt-string "\n%s") - arguments (append arguments (list (buffer-string)))))) + (ignore-errors + (with-current-buffer + (if (processp vec-or-proc) + (process-buffer vec-or-proc) + (tramp-get-connection-buffer vec-or-proc 'dont-create)) + (setq fmt-string (concat fmt-string "\n%s") + arguments (append arguments (list (buffer-string))))))) ;; Translate proc to vec. (when (processp vec-or-proc) (setq vec-or-proc (process-get vec-or-proc 'vector)))) @@ -2517,16 +2520,22 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;; This variable has been obsoleted in Emacs 26. tramp-completion-mode)) -(defun tramp-connectable-p (filename) +(defun tramp-connectable-p (vec-or-filename) "Check, whether it is possible to connect the remote host w/o side-effects. This is true, if either the remote host is already connected, or if we are not in completion mode." - (let (tramp-verbose) - (and (tramp-tramp-file-p filename) - (or (not (tramp-completion-mode-p)) - (process-live-p - (tramp-get-connection-process - (tramp-dissect-file-name filename))))))) + (let (tramp-verbose + (vec + (cond + ((tramp-file-name-p vec-or-filename) vec-or-filename) + ((tramp-tramp-file-p vec-or-filename) + (tramp-dissect-file-name vec-or-filename))))) + (when vec + (or ;; We check this for the process related to + ;; `tramp-buffer-name'; otherwise `start-file-process' + ;; wouldn't run ever when `non-essential' is non-nil. + (process-live-p (get-process (tramp-buffer-name vec))) + (not (tramp-completion-mode-p)))))) ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of @@ -2606,8 +2615,7 @@ not in completion mode." (try-completion filename (mapcar #'list (file-name-all-completions filename directory)) - (when (and predicate - (tramp-connectable-p (expand-file-name filename directory))) + (when (and predicate (tramp-connectable-p directory)) (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) ;; I misuse a little bit the `tramp-file-name' structure in order to @@ -3096,7 +3104,11 @@ User is always nil." (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - (not (null (file-attributes filename)))) + ;; `file-exists-p' is used as predicate in file name completion. + ;; We don't want to run it when `non-essential' is t, or there is + ;; no connection process yet. + (when (tramp-connectable-p filename) + (not (null (file-attributes filename))))) (defun tramp-handle-file-in-directory-p (filename directory) "Like `file-in-directory-p' for Tramp files." commit 997415504c37b4dc1f486b9d9925c4e16ade015c Author: Stefan Monnier Date: Thu Sep 12 08:25:13 2019 -0400 * src/profiler.c: Leave `key` hashslots as Qunbound (bug#37382) Now that "key == Qunbound" is used to determine if a hash table entry is available, we can't stash pre-allocated vectors into the `key` slot anymore, so use the `value` slot instead. (make_log): Pre-fill the `value` slots i.s.o `key`. (evict_lower_half): Stash key back into `value`, i.s.o `key`. (record_backtrace): Get pre-allocated vector for `value` i.s.o `key`. diff --git a/src/profiler.c b/src/profiler.c index 6943905062..84583cec76 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -66,11 +66,11 @@ make_log (void) Qnil, false); struct Lisp_Hash_Table *h = XHASH_TABLE (log); - /* What is special about our hash-tables is that the keys are pre-filled - with the vectors we'll put in them. */ + /* What is special about our hash-tables is that the values are pre-filled + with the vectors we'll use as keys. */ ptrdiff_t i = ASIZE (h->key_and_value) >> 1; while (i > 0) - set_hash_key_slot (h, --i, make_nil_vector (max_stack_depth)); + set_hash_value_slot (h, --i, make_nil_vector (max_stack_depth)); return log; } @@ -132,13 +132,14 @@ static void evict_lower_half (log_t *log) XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ Fremhash (key, tmp); } + eassert (EQ (Qunbound, HASH_KEY (log, i))); eassert (log->next_free == i); eassert (VECTORP (key)); for (ptrdiff_t j = 0; j < ASIZE (key); j++) ASET (key, j, Qnil); - set_hash_key_slot (log, i, key); + set_hash_value_slot (log, i, key); } } @@ -156,7 +157,8 @@ record_backtrace (log_t *log, EMACS_INT count) ptrdiff_t index = log->next_free; /* Get a "working memory" vector. */ - Lisp_Object backtrace = HASH_KEY (log, index); + Lisp_Object backtrace = HASH_VALUE (log, index); + eassert (EQ (Qunbound, HASH_KEY (log, index))); get_backtrace (backtrace); { /* We basically do a `gethash+puthash' here, except that we have to be