commit eac1271ae9dc6087be4383ded3f62ac3da030b54 (HEAD, refs/remotes/origin/master) Author: Artur Malabarba Date: Sun Jun 28 09:20:47 2015 +0100 * lisp/isearch.el (isearch-mode): Don't char-fold regexps (bug#20913) diff --git a/lisp/isearch.el b/lisp/isearch.el index 9ecbbdf..45c6d97 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -863,6 +863,7 @@ convert the search string to a regexp used by regexp search functions." (setq isearch-forward forward isearch-regexp regexp isearch-word (or word (and character-fold-search + (not regexp) 'character-fold-to-regexp)) isearch-op-fun op-fun isearch-last-case-fold-search isearch-case-fold-search commit bbf63ee00a3c263e3190320bc389bf0b72a5a9d5 Author: Dmitry Gutov Date: Sun Jun 28 04:38:11 2015 +0300 Bind grep-highlight-matches around the rgrep call * lisp/progmodes/grep.el (zrgrep): Bind grep-highlight-matches around the rgrep call (bug#20728). diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 639d8d9..3240ee8 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1089,9 +1089,6 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'." (grep-find-template nil) (grep-find-command nil) (grep-host-defaults-alist nil) - ;; Set `grep-highlight-matches' to `always' - ;; since `zgrep' puts filters in the grep output. - (grep-highlight-matches 'always) ;; Use for `grep-read-files' (grep-files-aliases '(("all" . "* .*") ("gz" . "*.gz")))) @@ -1109,7 +1106,10 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'." nil default-directory t)) (confirm (equal current-prefix-arg '(4)))) (list regexp files dir confirm grep-find-template))))))) - (let ((grep-find-template template)) + (let ((grep-find-template template) + ;; Set `grep-highlight-matches' to `always' + ;; since `zgrep' puts filters in the grep output. + (grep-highlight-matches 'always)) (rgrep regexp files dir confirm))) ;;;###autoload commit a1dde6b50fb8601b2a3ac333cc43569622a18500 Author: Dmitry Gutov Date: Sun Jun 28 04:29:03 2015 +0300 Put "--color" before the other options in grep-command * lisp/progmodes/grep.el (grep-compute-defaults): Put "--color" before the other options in grep-command (bug#20912). diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index e20e5bd..639d8d9 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -579,7 +579,7 @@ This function is called from `compilation-filter-hook'." " -e")))) (unless grep-command (setq grep-command - (format "%s %s %s " grep-program grep-options + (format "%s %s %s " grep-program (or (and grep-highlight-matches (grep-probe grep-program @@ -587,7 +587,8 @@ This function is called from `compilation-filter-hook'." nil 1) (if (eq grep-highlight-matches 'always) "--color=always" "--color")) - "")))) + "") + grep-options))) (unless grep-template (setq grep-template (format "%s %s " grep-program grep-options))) commit 9b4b4a8355506a0253d8a4943e0a9aa87f9e92eb Author: Dmitry Gutov Date: Fri Jun 26 20:21:50 2015 +0300 Add --color Grep option to the command dynamically * lisp/progmodes/grep.el (grep-template, grep-find-template): Update the description for . (Bug#20728) (grep-compute-defaults): Don't add the --color option to grep-options. Only add it to grep-command. (grep-expand-keywords): Expand the env value opts into . (grep-expand-template): Replace cf in the env with the opts list, that can include -i and --color. * lisp/progmodes/xref.el (xref-collect-matches): Do not remove "--color=always" from the template, because we don't have to. diff --git a/etc/NEWS b/etc/NEWS index 8463655..1f8cbbc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -883,6 +883,15 @@ word syntax, use `\sw' instead. ** The `diff' command uses the unified format now. To restore the old behavior, set `diff-switches' to `-c'. +** `grep-template' and `grep-find-template' values don't include the +--color argument anymore. It's added at the place holder position +dynamically. + +** `grep-template' and `grep-find-template' values don't include the +--color argument anymore. It's added at the place holder position +dynamically. Any third-party code that changes these templates should +be updated accordingly. + * Lisp Changes in Emacs 25.1 diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index cc6662f..e20e5bd 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -130,7 +130,7 @@ Customize or call the function `grep-apply-setting'." (defcustom grep-template nil "The default command to run for \\[lgrep]. The following place holders should be present in the string: - - place to put -i if case insensitive grep. + - place to put the options like -i and --color. - file names and wildcards to search. - file names and wildcards to exclude. - the regular expression searched for. @@ -177,7 +177,7 @@ The following place holders should be present in the string: - base directory for find - find options to restrict or expand the directory list - find options to limit the files matched - - place to put -i if case insensitive grep + - place to put the grep options like -i and --color - the regular expression searched for. In interactive usage, the actual value of this variable is set up by `grep-compute-defaults'; to change the default value, use @@ -572,20 +572,22 @@ This function is called from `compilation-filter-hook'." (unless (and grep-command grep-find-command grep-template grep-find-template) (let ((grep-options - (concat (and grep-highlight-matches - (grep-probe grep-program - `(nil nil nil "--color" "x" ,null-device) - nil 1) - (if (eq grep-highlight-matches 'always) - "--color=always " "--color ")) - (if grep-use-null-device "-n" "-nH") + (concat (if grep-use-null-device "-n" "-nH") (if (grep-probe grep-program `(nil nil nil "-e" "foo" ,null-device) nil 1) " -e")))) (unless grep-command (setq grep-command - (format "%s %s " grep-program grep-options))) + (format "%s %s %s " grep-program grep-options + (or + (and grep-highlight-matches + (grep-probe grep-program + `(nil nil nil "--color" "x" ,null-device) + nil 1) + (if (eq grep-highlight-matches 'always) + "--color=always" "--color")) + "")))) (unless grep-template (setq grep-template (format "%s %s " grep-program grep-options))) @@ -791,7 +793,7 @@ easily repeat a find command." ;; User-friendly interactive API. (defconst grep-expand-keywords - '(("" . (and cf (isearch-no-upper-case-p regexp t) "-i")) + '(("" . (mapconcat #'identity opts " ")) ("" . (or dir ".")) ("" . files) ("" . null-device) @@ -804,7 +806,16 @@ substitution string. Note dynamic scoping of variables.") (defun grep-expand-template (template &optional regexp files dir excl) "Patch grep COMMAND string replacing , , , , and ." (let* ((command template) - (env `((cf . ,case-fold-search) + (env `((opts . ,(let (opts) + (when (and case-fold-search + (isearch-no-upper-case-p regexp t)) + (push "-i" opts)) + (cond + ((eq grep-highlight-matches 'always) + (push "--color=always" opts)) + ((eq grep-highlight-matches 'auto) + (push "--color" opts))) + opts)) (excl . ,excl) (dir . ,dir) (files . ,files) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 469f65d..50d52d0 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -749,13 +749,8 @@ tools are used, and when." (require 'semantic/fw) (grep-compute-defaults) (defvar grep-find-template) - (let* ((grep-find-template - (replace-regexp-in-string - ;; Override the use ot '--color=always' on MS-Windows. - "--color=always" "" - (replace-regexp-in-string "-e " "-E " - grep-find-template t t) - t t)) + (let* ((grep-find-template (replace-regexp-in-string "-e " "-E " + grep-find-template t t)) (command (rgrep-default-command (xref--regexp-to-extended regexp) "*.*" dir)) (orig-buffers (buffer-list)) commit da5e0050ac161bd9d665c4b406a95bee4f3b4085 Author: Paul Eggert Date: Sat Jun 27 12:16:51 2015 -0700 cl-extra fixes for most-negative-fixnum * lisp/emacs-lisp/cl-extra.el (cl-gcd, cl-lcm, cl-random): Don't mishandle an argument equal to most-negative-fixnum, whose absolute value equals itself. (cl-gcd, cl-lcm): Use dolist rather than doing it by hand. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 0a6bc3a..3313cc7 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -299,22 +299,21 @@ If so, return the true (non-nil) value returned by PREDICATE. ;;;###autoload (defun cl-gcd (&rest args) "Return the greatest common divisor of the arguments." - (let ((a (abs (or (pop args) 0)))) - (while args - (let ((b (abs (pop args)))) - (while (> b 0) (setq b (% a (setq a b)))))) - a)) + (let ((a (or (pop args) 0))) + (dolist (b args) + (while (/= b 0) + (setq b (% a (setq a b))))) + (abs a))) ;;;###autoload (defun cl-lcm (&rest args) "Return the least common multiple of the arguments." (if (memq 0 args) 0 - (let ((a (abs (or (pop args) 1)))) - (while args - (let ((b (abs (pop args)))) - (setq a (* (/ a (cl-gcd a b)) b)))) - a))) + (let ((a (or (pop args) 1))) + (dolist (b args) + (setq a (* (/ a (cl-gcd a b)) b))) + (abs a)))) ;;;###autoload (defun cl-isqrt (x) @@ -431,7 +430,7 @@ Optional second arg STATE is a random-state object." ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. (let ((vec (aref state 3))) (if (integerp vec) - (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1)) + (let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1)) (aset state 3 (setq vec (make-vector 55 nil))) (aset vec 0 j) (while (> (setq i (% (+ i 21) 55)) 0) commit efc262f5f8a16d25c0db4e80fa52e693897fa41f Author: Paul Eggert Date: Sat Jun 27 10:57:02 2015 -0700 Initialize cl--gensym-counter to 0 Previously it was initialized to a random value, which made it harder to reproduce earlier Emacs runs. The need for a random value went away when Emacs introduced and used the #: syntax for uninterned symbols (Bug#20862). * doc/misc/cl.texi (Creating Symbols, Common Lisp Compatibility): Document that cl--gensym-counter now starts with 0. * lisp/emacs-lisp/cl-lib.el (cl--gensym-counter): Remove. (cl--random-time): Move to near only remaining use. * lisp/emacs-lisp/cl-macs.el (cl--gensym-counter): Initialize to 0. diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index d7b3f4a..1f38ca9 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -2877,14 +2877,8 @@ their names will not conflict with ``real'' variables in the user's code. (Internally, the variable @code{cl--gensym-counter} holds the counter -used to generate names. It is incremented after each use. In Common -Lisp this is initialized with 0, but this package initializes it with -a random time-dependent value to avoid trouble when two files that -each used @code{cl-gensym} in their compilation are loaded together. -Uninterned symbols become interned when the compiler writes them out -to a file and the Emacs loader loads them, so their names have to be -treated a bit more carefully than in Common Lisp where uninterned -symbols remain uninterned after loading.) +used to generate names. It is initialized with zero and incremented +after each use.) @end defun @defun cl-gentemp &optional x @@ -4543,10 +4537,7 @@ example, local @code{special} declarations, which are purely advisory in Emacs Lisp, do not rigorously obey the scoping rules set down in Steele's book. -The variable @code{cl--gensym-counter} starts out with a pseudo-random -value rather than with zero. This is to cope with the fact that -generated symbols become interned when they are written to and -loaded back from a file. +The variable @code{cl--gensym-counter} starts out with zero. The @code{cl-defstruct} facility is compatible, except that structures are of type @code{:type vector :named} by default rather than some diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index b6f3a79..2dd0519 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -249,16 +249,6 @@ so that they are registered at compile-time as well as run-time." `(progn ,@body)))) ; Avoid loading cl-macs.el for cl-eval-when. -;;; Symbols. - -(defun cl--random-time () - (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) - (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) - v)) - -(defvar cl--gensym-counter (* (logand (cl--random-time) 1023) 100)) - - ;;; Numbers. (define-obsolete-function-alias 'cl-floatp-safe 'floatp "24.4") @@ -298,6 +288,11 @@ If true return the decimal value of digit CHAR in RADIX." (let ((n (aref cl-digit-char-table char))) (and n (< n (or radix 10)) n))) +(defun cl--random-time () + (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) + (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) + v)) + (defvar cl--random-state (vector 'cl--random-state-tag -1 30 (cl--random-time))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 636c543..5bcf088 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -161,7 +161,7 @@ whether X is known at compile time, macroexpand it completely in ;;; Symbols. -(defvar cl--gensym-counter) +(defvar cl--gensym-counter 0) ;;;###autoload (defun cl-gensym (&optional prefix) "Generate a new uninterned symbol. commit 5e3fde03b45877d3e30f859a14c10043e637aa63 Author: Paul Eggert Date: Sat Jun 27 08:34:44 2015 -0700 Improve docstring for macroexp-let2 * lisp/emacs-lisp/macroexp.el (macroexp-let2): Improve as per suggestion by RMS in: http://lists.gnu.org/archive/html/emacs-devel/2015-06/msg00621.html Also, rename args to match new doc string. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e9af3b0..57cbec5 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -341,21 +341,44 @@ definitions to shadow the loaded ones for use in file byte-compilation." ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then)) (t `(if ,test ,then ,else)))) -(defmacro macroexp-let2 (test var exp &rest exps) - "Bind VAR to a copyable expression that returns the value of EXP. -This is like \\=`(let ((v ,EXP)) ,EXPS) except that `v' is a new generated -symbol which EXPS can find in VAR. -TEST should be the name of a predicate on EXP checking whether the `let' can -be skipped; if nil, as is usual, `macroexp-const-p' is used." +(defmacro macroexp-let2 (test sym exp &rest body) + "Evaluate BODY with SYM bound to an expression for EXP's value. +The intended usage is that BODY generates an expression that +will refer to EXP's value multiple times, but will evaluate +EXP only once. As BODY generates that expression, it should +use SYM to stand for the value of EXP. + +If EXP is a simple, safe expression, then SYM's value is EXP itself. +Otherwise, SYM's value is a symbol which holds the value produced by +evaluating EXP. The return value incorporates the value of BODY, plus +additional code to evaluate EXP once and save the result so SYM can +refer to it. + +If BODY consists of multiple forms, they are all evaluated +but only the last one's value matters. + +TEST is a predicate to determine whether EXP qualifies as simple and +safe; if TEST is nil, only constant expressions qualify. + +Example: + (macroexp-let2 nil foo EXP + \\=`(* ,foo ,foo)) +generates an expression that evaluates EXP once, +then returns the square of that value. +You could do this with + (let ((foovar EXP)) + (* foovar foovar)) +but using `macroexp-let2' produces more efficient code in +cases where EXP is a constant." (declare (indent 3) (debug (sexp sexp form body))) (let ((bodysym (make-symbol "body")) (expsym (make-symbol "exp"))) `(let* ((,expsym ,exp) - (,var (if (funcall #',(or test #'macroexp-const-p) ,expsym) - ,expsym (make-symbol ,(symbol-name var)))) - (,bodysym ,(macroexp-progn exps))) - (if (eq ,var ,expsym) ,bodysym - (macroexp-let* (list (list ,var ,expsym)) + (,sym (if (funcall #',(or test #'macroexp-const-p) ,expsym) + ,expsym (make-symbol ,(symbol-name sym)))) + (,bodysym ,(macroexp-progn body))) + (if (eq ,sym ,expsym) ,bodysym + (macroexp-let* (list (list ,sym ,expsym)) ,bodysym))))) (defmacro macroexp-let2* (test bindings &rest body) commit 7baae811651d73b3e89c832a5c15ff5b40c82635 Author: Eli Zaretskii Date: Sat Jun 27 14:27:23 2015 +0300 Fix VC test suite on MS-Windows * lisp/vc/vc-svn.el (vc-svn-create-repo): Make sure the file: URL always starts with 3 slashes after the colon. * test/automated/vc-tests.el (vc-test--create-repo-function): Use 'w32-application-type' to invoke CVS on MS-Windows with properly formatted CVSROOT directory name. diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 5ce9afa..f97e2ab 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -279,7 +279,15 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." ;; Expand default-directory because svn gets confused by eg ;; file://~/path/to/file. (Bug#15446). (vc-svn-command "*vc*" 0 "." "checkout" - (concat "file://" (expand-file-name default-directory) "SVN"))) + (let ((defdir (expand-file-name default-directory))) + (concat (if (and (stringp defdir) + (eq (aref defdir 0) ?/)) + "file://" + ;; MS-Windows files d:/foo/bar need to + ;; begin with 3 leading slashes. + "file:///") + defdir + "SVN")))) (autoload 'vc-switches "vc") diff --git a/test/automated/vc-tests.el b/test/automated/vc-tests.el index 58d2237..a7242e9 100644 --- a/test/automated/vc-tests.el +++ b/test/automated/vc-tests.el @@ -130,7 +130,19 @@ For backends which dont support it, it is emulated." (make-temp-name "vc-test") temporary-file-directory))) (make-directory (expand-file-name "module" tmp-dir) 'parents) (make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents) - (shell-command-to-string (format "cvs -Q -d:local:%s co module" tmp-dir)) + (if (not (fboundp 'w32-application-type)) + (shell-command-to-string (format "cvs -Q -d:local:%s co module" + tmp-dir)) + (let ((cvs-prog (executable-find "cvs")) + (tdir tmp-dir)) + ;; If CVS executable is an MSYS program, reformat the file + ;; name of TMP-DIR to have the /d/foo/bar form supported by + ;; MSYS programs. (FIXME: What about Cygwin cvs.exe?) + (if (eq (w32-application-type cvs-prog) 'msys) + (setq tdir + (concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2)))) + (shell-command-to-string (format "cvs -Q -d:local:%s co module" + tdir)))) (rename-file "module/CVS" default-directory) (delete-directory "module" 'recursive) ;; We must cleanup the "remote" CVS repo as well. commit 31807189b55d9519a46e4b35fadbe20218e4ebea Author: Eli Zaretskii Date: Sat Jun 27 13:48:26 2015 +0300 Add a new function w32-application-type * src/w32proc.c (Fw32_application_type): New function. ; * etc/NEWS: Mention w32-application-type. diff --git a/etc/NEWS b/etc/NEWS index ae62e76..8463655 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1114,6 +1114,10 @@ Pass '--without-ns' to configure to create an X11 build, the old default. ** OS X on PowerPC is no longer supported. +--- +** The new function 'w32-application-type' returns the type of an +MS-Windows application given the name of its executable program file. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/src/w32proc.c b/src/w32proc.c index 1f633d8..b301fcf 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1527,22 +1527,25 @@ waitpid (pid_t pid, int *status, int options) /* Implementation note: This function works with file names encoded in the current ANSI codepage. */ -static void +static int w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app, + int * is_msys_app, int * is_gui_app) { file_data executable; char * p; + int retval = 0; /* Default values in case we can't tell for sure. */ *is_dos_app = FALSE; *is_cygnus_app = FALSE; + *is_msys_app = FALSE; *is_gui_app = FALSE; if (!open_input_file (&executable, filename)) - return; + return -1; p = strrchr (filename, '.'); @@ -1560,7 +1563,8 @@ w32_executable_type (char * filename, extension, which is defined in the registry. */ p = egetenv ("COMSPEC"); if (p) - w32_executable_type (p, is_dos_app, is_cygnus_app, is_gui_app); + retval = w32_executable_type (p, is_dos_app, is_cygnus_app, is_msys_app, + is_gui_app); } else { @@ -1637,6 +1641,16 @@ w32_executable_type (char * filename, *is_cygnus_app = TRUE; break; } + else if (strncmp (dllname, "msys-", 5) == 0) + { + /* This catches both MSYS 1.x and MSYS2 + executables (the DLL name is msys-1.0.dll and + msys-2.0.dll, respectively). There's doesn't + seem to be a reason to distinguish between + the two, for now. */ + *is_msys_app = TRUE; + break; + } } } } @@ -1644,6 +1658,7 @@ w32_executable_type (char * filename, unwind: close_file_data (&executable); + return retval; } static int @@ -1702,7 +1717,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) int arglen, numenv; pid_t pid; child_process *cp; - int is_dos_app, is_cygnus_app, is_gui_app; + int is_dos_app, is_cygnus_app, is_msys_app, is_gui_app; int do_quoting = 0; /* We pass our process ID to our children by setting up an environment variable in their environment. */ @@ -1713,10 +1728,10 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) argument being split into two or more. Arguments with wildcards are also quoted, for consistency with posix platforms, where wildcards are not expanded if we run the program directly without a shell. - Some extra whitespace characters need quoting in Cygwin programs, + Some extra whitespace characters need quoting in Cygwin/MSYS programs, so this list is conditionally modified below. */ char *sepchars = " \t*?"; - /* This is for native w32 apps; modified below for Cygwin apps. */ + /* This is for native w32 apps; modified below for Cygwin/MSUS apps. */ char escape_char = '\\'; char cmdname_a[MAX_PATH]; @@ -1777,15 +1792,17 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) cmdname = cmdname_a; argv[0] = cmdname; - /* Determine whether program is a 16-bit DOS executable, or a 32-bit Windows - executable that is implicitly linked to the Cygnus dll (implying it - was compiled with the Cygnus GNU toolchain and hence relies on - cygwin.dll to parse the command line - we use this to decide how to - escape quote chars in command line args that must be quoted). + /* Determine whether program is a 16-bit DOS executable, or a 32-bit + Windows executable that is implicitly linked to the Cygnus or + MSYS dll (implying it was compiled with the Cygnus/MSYS GNU + toolchain and hence relies on cygwin.dll or MSYS DLL to parse the + command line - we use this to decide how to escape quote chars in + command line args that must be quoted). Also determine whether it is a GUI app, so that we don't hide its initial window unless specifically requested. */ - w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_gui_app); + w32_executable_type (cmdname, &is_dos_app, &is_cygnus_app, &is_msys_app, + &is_gui_app); /* On Windows 95, if cmdname is a DOS app, we invoke a helper application to start it by specifying the helper app as cmdname, @@ -1845,10 +1862,10 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) if (INTEGERP (Vw32_quote_process_args)) escape_char = XINT (Vw32_quote_process_args); else - escape_char = is_cygnus_app ? '"' : '\\'; + escape_char = (is_cygnus_app || is_msys_app) ? '"' : '\\'; } - /* Cygwin apps needs quoting a bit more often. */ + /* Cygwin/MSYS apps need quoting a bit more often. */ if (escape_char == '"') sepchars = "\r\n\t\f '"; @@ -1866,7 +1883,7 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) for ( ; *p; p++) { if (escape_char == '"' && *p == '\\') - /* If it's a Cygwin app, \ needs to be escaped. */ + /* If it's a Cygwin/MSYS app, \ needs to be escaped. */ arglen++; else if (*p == '"') { @@ -2947,6 +2964,59 @@ If successful, the return value is t, otherwise nil. */) return result; } +DEFUN ("w32-application-type", Fw32_application_type, + Sw32_application_type, 1, 1, 0, + doc: /* Return the type of an MS-Windows PROGRAM. + +Knowing the type of an executable could be useful for formatting +file names passed to it or for quoting its command-line arguments. + +PROGRAM should specify an executable file, including the extension. + +The value is one of the following: + +`dos' -- a DOS .com program or some other non-PE executable +`cygwin' -- a Cygwin program that depends on Cygwin DLL +`msys' -- an MSYS 1.x or MSYS2 program +`w32-native' -- a native Windows application +`unknown' -- a file that doesn't exist, or cannot be open, or whose + name is not encodable in the current ANSI codepage. + +Note that for .bat and .cmd batch files the function returns the type +of their command interpreter, as specified by the \"COMSPEC\" +environment variable. + +This function returns `unknown' for programs whose file names +include characters not supported by the current ANSI codepage, as +such programs cannot be invoked by Emacs anyway. */) + (Lisp_Object program) +{ + int is_dos_app, is_cygwin_app, is_msys_app, dummy; + Lisp_Object encoded_progname; + char *progname, progname_a[MAX_PATH]; + + program = Fexpand_file_name (program, Qnil); + encoded_progname = ENCODE_FILE (program); + progname = SDATA (encoded_progname); + unixtodos_filename (progname); + filename_to_ansi (progname, progname_a); + /* Reject file names that cannot be encoded in the current ANSI + codepage. */ + if (_mbspbrk (progname_a, "?")) + return Qunknown; + + if (w32_executable_type (progname_a, &is_dos_app, &is_cygwin_app, + &is_msys_app, &dummy) != 0) + return Qunknown; + if (is_dos_app) + return Qdos; + if (is_cygwin_app) + return Qcygwin; + if (is_msys_app) + return Qmsys; + return Qw32_native; +} + #ifdef HAVE_LANGINFO_CODESET /* Emulation of nl_langinfo. Used in fns.c:Flocale_info. */ char * @@ -3541,6 +3611,9 @@ syms_of_ntproc (void) { DEFSYM (Qhigh, "high"); DEFSYM (Qlow, "low"); + DEFSYM (Qcygwin, "cygwin"); + DEFSYM (Qmsys, "msys"); + DEFSYM (Qw32_native, "w32-native"); defsubr (&Sw32_has_winsock); defsubr (&Sw32_unload_winsock); @@ -3548,6 +3621,7 @@ syms_of_ntproc (void) defsubr (&Sw32_short_file_name); defsubr (&Sw32_long_file_name); defsubr (&Sw32_set_process_priority); + defsubr (&Sw32_application_type); defsubr (&Sw32_get_locale_info); defsubr (&Sw32_get_current_locale_id); defsubr (&Sw32_get_default_locale_id);