Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
openSUSE:Leap:15.0:Ports
lilypond
Issue-5243-1-editor-scm-Add-shell-quote-argumen...
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File Issue-5243-1-editor-scm-Add-shell-quote-argument-function.diff of Package lilypond
From: David Kastrup <dak@gnu.org> Date: Tue, 28 Nov 2017 11:18:07 +0000 (+0100) Subject: Issue 5243/1: (editor scm): Add shell-quote-argument function X-Git-Url: http://git.savannah.gnu.org/gitweb/?p=lilypond.git;a=commitdiff_plain;h=807f5eb8cd631133da3be6897e3e8fa7202e089d Issue 5243/1: (editor scm): Add shell-quote-argument function This is mostly stolen from Emacs. --- Index: scm/editor.scm =================================================================== --- scm/editor.scm.orig 2014-03-17 17:29:16.000000000 +0200 +++ scm/editor.scm 2018-05-15 10:48:31.408441118 +0200 @@ -40,6 +40,100 @@ (else "emacs")))) +;; A bunch of stuff stolen from Emacs + +(define (w32-using-nt) + "Return non-nil if running on a Windows NT descendant. +That includes all Windows systems except for 9X/Me." + (getenv "SystemRoot")) + +(define (w32-shell-name) + "Return the name of the shell being used." + (or (getenv "SHELL") + (and (w32-using-nt) "cmd.exe") + "command.com")) + +(define w32-system-shells '("cmd" "cmd.exe" "command" "command.com" + "4nt" "4nt.exe" "4dos" "4dos.exe" + "tcc" "tcc.exe" "ndos" "ndos.exe")) + +(define (w32-system-shell-p shell-name) + (and shell-name + (member (string-downcase + (basename shell-name)) + w32-system-shells))) + +(define (w32-shell-dos-semantics) + "Return non-nil if the interactive shell being used expects MS-DOS shell semantics." + (or (w32-system-shell-p (w32-shell-name)) + (and (member (string-downcase (basename (w32-shell-name))) + '("cmdproxy" "cmdproxy.exe")) + (w32-system-shell-p (getenv "COMSPEC"))))) + +(define-public (shell-quote-argument argument) + "Quote ARGUMENT for passing as argument to an inferior shell. + +This function is designed to work with the syntax of your system's +standard shell, and might produce incorrect results with unusual shells. +See Info node `(elisp)Security Considerations'." + (cond + ((and (eq? PLATFORM 'windows) (w32-shell-dos-semantics)) + + ;; First, quote argument so that CommandLineToArgvW will + ;; understand it. See + ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx + ;; After we perform that level of quoting, escape shell + ;; metacharacters so that cmd won't mangle our argument. If the + ;; argument contains no double quote characters, we can just + ;; surround it with double quotes. Otherwise, we need to prefix + ;; each shell metacharacter with a caret. + + (set! argument + ;; escape backslashes at end of string + (regexp-substitute/global + #f + "(\\\\+)$" + ;; escape backslashes and quotes in string body + (regexp-substitute/global + #f + "(\\\\*)\"" + argument + 'pre 1 1 "\\\"" 'post) + 'pre 1 1 'post)) + + (if (string-match "[%!\"]" argument) + (string-append + "^\"" + (regexp-substitute/global + #f + "[%!()\"<>&|^]" + argument + 'pre "^" 0 'post) + "^\"") + (string-append "\"" argument "\""))) + + (else + (if (string-null? argument) + "''" + ;; Quote everything except POSIX filename characters. + ;; This should be safe enough even for really weird shells. + (regexp-substitute/global + #f + "\n" + (regexp-substitute/global + #f +;;; "[^-0-9a-zA-Z_./\n]" Negative ranges are too dangerous since +;;; their UTF-8 implications aren't clear: we don't want +;;; characters outside the ASCII range quoted since it is not +;;; clear whether we need to quote bytes or characters. So we just +;;; invert the above regexp pattern for Posix characters manually. + "[\x01-\x09\x0b-,:-@[-^{-\x7f]" + argument + 'pre "\\" 0 'post) + 'pre "'\n'" 'post))) + )) + + (define editor-command-template-alist '(("emacs" . "emacsclient --no-wait +%(line)s:%(column)s %(file)s || (emacs +%(line)s:%(column)s %(file)s&)") ("gvim" . "gvim --remote +:%(line)s:norm%(column)s %(file)s")
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor