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.
This commit is contained in:
Michael Albinus 2020-11-21 15:28:52 +01:00
parent 2c7687738d
commit 789ee3e1d5
6 changed files with 178 additions and 92 deletions

View file

@ -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

View file

@ -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-<left>' and 's-<right>' 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-`'.

View file

@ -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)

View file

@ -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
'((shell-file-name . "/system/bin/sh")
(shell-command-switch . "-c"))
"Default connection-local variables for remote adb connections.")
;;; 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 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)
(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 ()

View file

@ -262,23 +262,39 @@ NAME must be equal to `tramp-current-connection'."
(info-lookup->topic-cache 'symbol))))))))
;;; Default connection-local variables for Tramp:
(defconst tramp-connection-local-default-profile
'((shell-file-name . "/bin/sh")
(shell-command-switch . "-c"))
"Default connection-local variables for remote connections.")
;; `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-shell-variables
'((shell-file-name . "/bin/sh")
(shell-command-switch . "-c"))
"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)
(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)))

View file

@ -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 <X> <C> %s <R> <F>" 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 <C> %s <R>"
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 <D> <X> -type f <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."
'(("<C>" . (mapconcat #'identity opts " "))
("<D>" . (or dir "."))
("<F>" . files)
("<N>" . null-device)
("<N>" . (null-device))
("<X>" . excl)
("<R>" . (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))))))