From 789ee3e1d55a86b9ce38d1374c0e01d04f97eb7d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 21 Nov 2020 15:28:52 +0100 Subject: [PATCH] Handle connection-local null-device and path-separator variables * doc/lispref/os.texi (System Environment): Add `path-separator' function and `null-device' variable and function. * etc/NEWS: Mention 'null-device' and 'path-separator'. Fix typos. * lisp/files-x.el (path-separator, null-device): New defuns. (Bug#3736) * lisp/net/tramp-adb.el (tramp-adb-connection-local-default-shell-variables): Rename from `tramp-adb-connection-local-default-profile'. * lisp/net/tramp-integration.el (tramp-connection-local-default-system-variables): New defvar. Add it to connection-local profiles. (tramp-connection-local-default-shell-variables): Rename from `tramp-connection-local-default-profile'. * lisp/progmodes/grep.el (grep-hello-file): New defun. (grep-compute-defaults): Use `null-device' function for remote case. Handle remote `hello-file'. Use `process-file-shell-command'. (grep,grep-expand-keywords, lgrep): Use `null-device' function for remote case. --- doc/lispref/os.texi | 22 ++++- etc/NEWS | 31 +++++--- lisp/files-x.el | 10 +++ lisp/net/tramp-adb.el | 21 ++--- lisp/net/tramp-integration.el | 34 +++++--- lisp/progmodes/grep.el | 146 +++++++++++++++++++++------------- 6 files changed, 175 insertions(+), 89 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 2c30d8ad892..f897cfa4eab 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1077,12 +1077,19 @@ directories in a search path (as found in an environment variable). Its value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems. @end defvar +@defun path-separator +This function returns the connection-local value of variable +@code{path-separator}. That is @code{";"} for MS systems and a local +@code{default-directory}, and @code{":"} for Unix and GNU systems, or +a remote @code{default-directory}. +@end defun + @defun parse-colon-path path This function takes a search path string such as the value of the @env{PATH} environment variable, and splits it at the separators, returning a list of directories. @code{nil} in this list means the current directory. Although the function's name says -``colon'', it actually uses the value of @code{path-separator}. +``colon'', it actually uses the value of variable @code{path-separator}. @example (parse-colon-path ":/foo:/bar") @@ -1155,6 +1162,19 @@ in the system's terminal driver, before Emacs was started. @c The value is @code{nil} if Emacs is running under a window system. @end defvar +@defvar null-device +This variable holds the system null device. Its value is +@code{"/dev/null"} for Unix and GNU systems, and @code{"NUL"} for MS +systems. +@end defvar + +@defun null-device +This function returns the connection-local value of variable +@code{null-device}. That is @code{"NUL"} for MS systems and a local +@code{default-directory}, and @code{"/dev/null"} for Unix and GNU +systems, or a remote @code{default-directory}. +@end defun + @node User Identification @section User Identification @cindex user identification diff --git a/etc/NEWS b/etc/NEWS index efec6743237..0cfca39c80f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -103,7 +103,7 @@ unsystematic behavior, which mixed these two is no longer available. +++ ** New system for displaying documentation for groups of functions. This can either be used by saying 'M-x shortdoc-display-group' and -choosing a group, or clicking a button in the *Help* buffers when +choosing a group, or clicking a button in the "*Help*" buffers when looking at the doc string of a function that belongs to one of these groups. @@ -187,6 +187,11 @@ space characters. freenode IRC network for years now. Occurrences of "irc.freenode.net" have been replaced with "chat.freenode.net" throughout Emacs. ++++ +** New functions 'null-device' and 'path-separator'. +These functions return the connection local value of the respective +variables. This can be used for remote hosts. + * Editing Changes in Emacs 28.1 @@ -288,7 +293,7 @@ indentation is done using SMIE or with the old ad-hoc code. When a warning is displayed to the user, the resulting buffer now has buttons which allow making permanent changes to the treatment of that warning. Automatic showing of the warning can be disabled (although -it is still logged to the *Messages* buffer), or the warning can be +it is still logged to the "*Messages*" buffer), or the warning can be disabled entirely. ** mspool.el @@ -477,13 +482,13 @@ tags to be considered as well. ** Gnus +++ -*** New gnus-search library +*** New gnus-search library. A new unified search syntax which can be used across multiple supported search engines. Set 'gnus-search-use-parsed-queries' to non-nil to enable. +++ -*** New value for user option 'smiley-style' +*** New value for user option 'smiley-style'. Smileys can now be rendered with emojis instead of small images when using the new 'emoji' value in 'smiley-style'. @@ -716,11 +721,11 @@ To revert to the previous behavior, *** Most customize commands now hide obsolete user options. Obsolete user options are no longer shown in the listings produced by -the commands `customize', `customize-group', `customize-apropos' and -`customize-changed-options'. +the commands 'customize', 'customize-group', 'customize-apropos' and +'customize-changed-options'. -To customize obsolete user options, use `customize-option' or -`customize-saved'. +To customize obsolete user options, use 'customize-option' or +'customize-saved'. ** Edebug @@ -886,7 +891,7 @@ Customize 'gdb-max-source-window-count' to use more than one window. Control source file display by 'gdb-display-source-buffer-action'. +++ -*** The default value of gdb-mi-decode-strings is now t. +*** The default value of 'gdb-mi-decode-strings' is now t. This means that the default coding-system is now used to decode strings and source file names from GDB. @@ -1155,8 +1160,8 @@ project's root directory, respectively. ** xref --- -*** Prefix arg of 'xref-goto-xref' quits the *xref* buffer. -So typing 'C-u RET' in the *xref* buffer quits its window +*** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer. +So typing 'C-u RET' in the "*xref*" buffer quits its window before navigating to the selected location. ** json.el @@ -1339,7 +1344,7 @@ buffers. This can be controlled by customizing the variable --- *** New user option 'compilation-search-all-directories'. When doing parallel builds, directories and compilation errors may -arrive in the *compilation* buffer out-of-order. If this variable is +arrive in the "*compilation*" buffer out-of-order. If this variable is non-nil (the default), Emacs will now search backwards in the buffer for any directory the file with errors may be in. If nil, this won't be done (and this restores how this previously worked). @@ -2016,7 +2021,7 @@ image API via 'M-x report-emacs-bug'. -- ** On macOS, 's-' and 's-' are now bound to -'move-beginning-of-line' and 'move-end-of-line' respectively. The commands +'move-beginning-of-line' and 'move-end-of-line' respectively. The commands to select previous/next frame are still bound to 's-~' and 's-`'. diff --git a/lisp/files-x.el b/lisp/files-x.el index 911e7ba9e3d..620a2e23f56 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -730,6 +730,16 @@ Execute BODY, and unwind connection-local variables." ;; No connection-local variables to apply. ,@body)) +;;;###autoload +(defun path-separator () + "The connection-local value of `path-separator'." + (with-connection-local-variables path-separator)) + +;;;###autoload +(defun null-device () + "The connection-local value of `null-device'." + (with-connection-local-variables null-device)) + (provide 'files-x) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7cdb7ebf536..750b735c1b9 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1316,23 +1316,24 @@ connection if a previous connection has died for some reason." ;; Mark it as connected. (tramp-set-connection-property p "connected" t))))))) -;; Default settings for connection-local variables. -(defconst tramp-adb-connection-local-default-profile +;;; Default connection-local variables for Tramp: +;; `connection-local-set-profile-variables' and +;; `connection-local-set-profiles' exists since Emacs 26.1. +(defconst tramp-adb-connection-local-default-shell-variables '((shell-file-name . "/system/bin/sh") (shell-command-switch . "-c")) - "Default connection-local variables for remote adb connections.") + "Default connection-local shell variables for remote adb connections.") + +(tramp-compat-funcall + 'connection-local-set-profile-variables + 'tramp-adb-connection-local-default-shell-profile + tramp-adb-connection-local-default-shell-variables) -;; `connection-local-set-profile-variables' and -;; `connection-local-set-profiles' exists since Emacs 26.1. (with-eval-after-load 'shell - (tramp-compat-funcall - 'connection-local-set-profile-variables - 'tramp-adb-connection-local-default-profile - tramp-adb-connection-local-default-profile) (tramp-compat-funcall 'connection-local-set-profiles `(:application tramp :protocol ,tramp-adb-method) - 'tramp-adb-connection-local-default-profile)) + 'tramp-adb-connection-local-default-shell-profile)) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 7e4a9bf05e5..566c673af16 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -262,23 +262,39 @@ NAME must be equal to `tramp-current-connection'." (info-lookup->topic-cache 'symbol)))))))) ;;; Default connection-local variables for Tramp: +;; `connection-local-set-profile-variables' and +;; `connection-local-set-profiles' exists since Emacs 26.1. + +(defconst tramp-connection-local-default-system-variables + '((path-separator . ":") + (null-device . "/dev/null")) + "Default connection-local system variables for remote connections.") + +(tramp-compat-funcall + 'connection-local-set-profile-variables + 'tramp-connection-local-default-system-profile + tramp-connection-local-default-system-variables) + +(tramp-compat-funcall + 'connection-local-set-profiles + `(:application tramp) + 'tramp-connection-local-default-system-profile) -(defconst tramp-connection-local-default-profile +(defconst tramp-connection-local-default-shell-variables '((shell-file-name . "/bin/sh") (shell-command-switch . "-c")) - "Default connection-local variables for remote connections.") + "Default connection-local shell variables for remote connections.") + +(tramp-compat-funcall + 'connection-local-set-profile-variables + 'tramp-connection-local-default-shell-profile + tramp-connection-local-default-shell-variables) -;; `connection-local-set-profile-variables' and -;; `connection-local-set-profiles' exists since Emacs 26.1. (with-eval-after-load 'shell - (tramp-compat-funcall - 'connection-local-set-profile-variables - 'tramp-connection-local-default-profile - tramp-connection-local-default-profile) (tramp-compat-funcall 'connection-local-set-profiles `(:application tramp) - 'tramp-connection-local-default-profile)) + 'tramp-connection-local-default-shell-profile)) (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-integration 'force))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 96838269749..dafba22f777 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -296,8 +296,10 @@ See `compilation-error-screen-columns'." :help "Kill the currently running grep process")) (define-key map [menu-bar grep compilation-separator2] '("----")) (define-key map [menu-bar grep compilation-compile] - '(menu-item "Compile..." compile - :help "Compile the program including the current buffer. Default: run `make'")) + '(menu-item + "Compile..." compile + :help + "Compile the program including the current buffer. Default: run `make'")) (define-key map [menu-bar grep compilation-rgrep] '(menu-item "Recursive grep..." rgrep :help "User-friendly recursive grep in directory tree")) @@ -308,15 +310,18 @@ See `compilation-error-screen-columns'." '(menu-item "Grep via Find..." grep-find :help "Run grep via find, with user-specified args")) (define-key map [menu-bar grep compilation-grep] - '(menu-item "Another grep..." grep - :help "Run grep, with user-specified args, and collect output in a buffer.")) + '(menu-item + "Another grep..." grep + :help + "Run grep, with user-specified args, and collect output in a buffer.")) (define-key map [menu-bar grep compilation-recompile] '(menu-item "Repeat grep" recompile :help "Run grep again")) (define-key map [menu-bar grep compilation-separator1] '("----")) (define-key map [menu-bar grep compilation-first-error] - '(menu-item "First Match" first-error - :help "Restart at the first match, visit corresponding location")) + '(menu-item + "First Match" first-error + :help "Restart at the first match, visit corresponding location")) (define-key map [menu-bar grep compilation-previous-error] '(menu-item "Previous Match" previous-error :help "Visit the previous match and corresponding location")) @@ -389,7 +394,8 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) + (mbeg + (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) . @@ -397,8 +403,11 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) - (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) + (mbeg + (text-property-any beg end 'font-lock-face grep-match-face)) + (mend + (and mbeg (next-single-property-change + mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil @@ -614,6 +623,15 @@ This function is called from `compilation-filter-hook'." (error nil)) (or result 0)))) +(defun grep-hello-file () + (let ((result + (if (file-remote-p default-directory) + (make-temp-file (file-name-as-directory (temporary-file-directory))) + (expand-file-name "HELLO" data-directory)))) + (when (file-remote-p result) + (write-region "Copyright\n" nil result)) + result)) + ;;;###autoload (defun grep-compute-defaults () "Compute the defaults for the `grep' command. @@ -655,37 +673,46 @@ The value depends on `grep-command', `grep-template', (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) (setq grep-use-null-device (with-temp-buffer - (let ((hello-file (expand-file-name "HELLO" data-directory))) - (not - (and (if grep-command - ;; `grep-command' is already set, so - ;; use that for testing. - (grep-probe grep-command - `(nil t nil "^Copyright" ,hello-file) - #'call-process-shell-command) - ;; otherwise use `grep-program' - (grep-probe grep-program - `(nil t nil "-nH" "^Copyright" ,hello-file))) - (progn - (goto-char (point-min)) - (looking-at - (concat (regexp-quote hello-file) - ":[0-9]+:Copyright"))))))))) + (let ((hello-file (grep-hello-file))) + (prog1 + (not + (and (if grep-command + ;; `grep-command' is already set, so + ;; use that for testing. + (grep-probe + grep-command + `(nil t nil "^Copyright" + ,(file-local-name hello-file)) + #'process-file-shell-command) + ;; otherwise use `grep-program' + (grep-probe + grep-program + `(nil t nil "-nH" "^Copyright" + ,(file-local-name hello-file)))) + (progn + (goto-char (point-min)) + (looking-at + (concat (regexp-quote (file-local-name hello-file)) + ":[0-9]+:Copyright"))))) + (when (file-remote-p hello-file) (delete-file hello-file))))))) (when (eq grep-use-null-filename-separator 'auto-detect) (setq grep-use-null-filename-separator (with-temp-buffer - (let* ((hello-file (expand-file-name "HELLO" data-directory)) - (args `("--null" "-ne" "^Copyright" ,hello-file))) + (let* ((hello-file (grep-hello-file)) + (args `("--null" "-ne" "^Copyright" + ,(file-local-name hello-file)))) (if grep-use-null-device - (setq args (append args (list null-device))) + (setq args (append args (list (null-device)))) (push "-H" args)) - (and (grep-probe grep-program `(nil t nil ,@args)) - (progn - (goto-char (point-min)) - (looking-at - (concat (regexp-quote hello-file) - "\0[0-9]+:Copyright")))))))) + (prog1 + (and (grep-probe grep-program `(nil t nil ,@args)) + (progn + (goto-char (point-min)) + (looking-at + (concat (regexp-quote (file-local-name hello-file)) + "\0[0-9]+:Copyright")))) + (when (file-remote-p hello-file) (delete-file hello-file))))))) (when (eq grep-highlight-matches 'auto-detect) (setq grep-highlight-matches @@ -704,7 +731,7 @@ The value depends on `grep-command', `grep-template', (concat (if grep-use-null-device "-n" "-nH") (if grep-use-null-filename-separator " --null") (when (grep-probe grep-program - `(nil nil nil "-e" "foo" ,null-device) + `(nil nil nil "-e" "foo" ,(null-device)) nil 1) " -e")))) (unless grep-command @@ -712,13 +739,14 @@ The value depends on `grep-command', `grep-template', (format "%s %s %s " grep-program (or (and grep-highlight-matches - (grep-probe grep-program - `(nil nil nil "--color" "x" ,null-device) - nil 1) + (grep-probe + grep-program + `(nil nil nil "--color" "x" ,(null-device)) + nil 1) (if (eq grep-highlight-matches 'always) "--color=always" "--color")) "") - grep-options))) + grep-options))) (unless grep-template (setq grep-template (format "%s %s " grep-program grep-options))) @@ -726,11 +754,12 @@ The value depends on `grep-command', `grep-template', (setq grep-find-use-xargs (cond ((grep-probe find-program - `(nil nil nil ,null-device "-exec" "echo" + `(nil nil nil ,(null-device) "-exec" "echo" "{}" "+")) 'exec-plus) ((and - (grep-probe find-program `(nil nil nil ,null-device "-print0")) + (grep-probe + find-program `(nil nil nil ,(null-device) "-print0")) (grep-probe xargs-program '(nil nil nil "-0" "echo"))) 'gnu) (t @@ -750,12 +779,13 @@ The value depends on `grep-command', `grep-template', (let ((cmd0 (format "%s . -type f -exec %s" find-program grep-command)) (null (if grep-use-null-device - (format "%s " null-device) + (format "%s " (null-device)) ""))) (cons (if (eq grep-find-use-xargs 'exec-plus) (format "%s %s%s +" cmd0 null quot-braces) - (format "%s %s %s%s" cmd0 quot-braces null quot-scolon)) + (format "%s %s %s%s" + cmd0 quot-braces null quot-scolon)) (1+ (length cmd0))))) (t (format "%s . -type f -print | \"%s\" %s" @@ -765,7 +795,7 @@ The value depends on `grep-command', `grep-template', (let ((gcmd (format "%s %s " grep-program grep-options)) (null (if grep-use-null-device - (format "%s " null-device) + (format "%s " (null-device)) ""))) (cond ((eq grep-find-use-xargs 'gnu) (format "%s -type f -print0 | \"%s\" -0 %s" @@ -814,7 +844,8 @@ The value depends on `grep-command', `grep-template', (let ((tag-default (shell-quote-argument (grep-tag-default))) ;; This a regexp to match single shell arguments. ;; Could someone please add comments explaining it? - (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") + (sh-arg-re + "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") (grep-default (or (car grep-history) grep-command))) ;; In the default command, find the arg that specifies the pattern. (when (or (string-match @@ -909,8 +940,8 @@ list is empty)." (grep--save-buffers) ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. - (compilation-start (if (and grep-use-null-device null-device) - (concat command-args " " null-device) + (compilation-start (if (and grep-use-null-device null-device (null-device)) + (concat command-args " " (null-device)) command-args) #'grep-mode)) @@ -948,7 +979,7 @@ easily repeat a find command." '(("" . (mapconcat #'identity opts " ")) ("" . (or dir ".")) ("" . files) - ("" . null-device) + ("" . (null-device)) ("" . excl) ("" . (shell-quote-argument (or regexp "")))) "List of substitutions performed by `grep-expand-template'. @@ -1052,8 +1083,9 @@ REGEXP is used as a string in the prompt." #'read-file-name-internal nil nil nil 'grep-files-history (delete-dups - (delq nil (append (list default default-alias default-extension) - (mapcar #'car grep-files-aliases))))))) + (delq nil + (append (list default default-alias default-extension) + (mapcar #'car grep-files-aliases))))))) (and files (or (cdr (assoc files grep-files-aliases)) files)))) @@ -1105,11 +1137,12 @@ command before it's run." (if (string= command grep-command) (setq command nil)) (setq dir (file-name-as-directory (expand-file-name dir))) - (unless (or (not grep-use-directories-skip) (eq grep-use-directories-skip t)) + (unless (or (not grep-use-directories-skip) + (eq grep-use-directories-skip t)) (setq grep-use-directories-skip (grep-probe grep-program `(nil nil nil "--directories=skip" "foo" - ,null-device) + ,(null-device)) nil 1))) (setq command (grep-expand-template grep-template @@ -1141,10 +1174,11 @@ command before it's run." ;; Setting process-setup-function makes exit-message-function work ;; even when async processes aren't supported. (grep--save-buffers) - (compilation-start (if (and grep-use-null-device null-device) - (concat command " " null-device) - command) - 'grep-mode)) + (compilation-start + (if (and grep-use-null-device null-device (null-device)) + (concat command " " (null-device)) + command) + 'grep-mode)) ;; Set default-directory if we started lgrep in the *grep* buffer. (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) -- 2.39.5