* perldb (in gud.el) aborts for a Perl script when its path includes whitespace
@ 2003-06-27 10:30 Taro Kawagishi
0 siblings, 0 replies; only message in thread
From: Taro Kawagishi @ 2003-06-27 10:30 UTC (permalink / raw)
Hello,
I have a fix to the problem of perldb function within gud.el.
This problem surfaces when you try to debug a Perl script whose path
name includes whitespace characters in it.
It is not uncommon to use such file (directory) names (more so on
Windows, I guess).
The function perldb presents the user with perl executable name and
the Perl script name in the command line format in the minibuffer.
gud-common-init then separates perl executable name and the script
name using split-string, based on the assumption that there is no
whitespace in the script path name.
If the script path name includes whitespace characters in it,
split-string will give a wrong path name and the rest of
gud-common-init fails without being able to find the script file.
e.g. for d:/home/tarok/bin/Dir with space/cmpFiles.pl
Can't open perl script "d:/home/tarok/bin/Dir": No such file or directory
Debugger exited abnormally with code 2
Solution 1
You can eliminate whitespace in the path name by encoding the path in
some way before passing it to split-string. I used URL encoding style
here and the space character is now represented %20.
Solution 2
You can quote the path name within double quote as is done with the
regular shell on UNIX (and command prompt on Windows), and use
split-string-escape-dq instead of split-string.
Solution 3
Just rename all directories and files so that they don't include spaces.
I don't want to accept solution 3 :-)
so I would like to use either solution 1 or 2 but I don't know which one is better.
Also I haven't fully tested split-string-escape-dq below.
Emacs version
GNU Emacs 21.3.1 (i386-msvc-nt5.0.2195) of 2003-03-28 on buffy
No modification made to the binary release for Windows.
I will include diff's of two methods below.
Solution 1
--- gud.original.el 2002-10-24 22:07:56.000000000 +0900
+++ gud.el 2003-06-27 18:35:39.000000000 +0900
@@ -1286,7 +1286,7 @@
and source-file directory for your debugger."
(interactive
(list (gud-query-cmdline 'perldb
- (concat (or (buffer-file-name) "-e 0") " "))))
+ (concat (or (encode-space-quote-hexadecimal (buffer-file-name)) "-e 0") " "))))
(gud-common-init command-line 'gud-perldb-massage-args
'gud-perldb-marker-filter 'gud-perldb-find-file)
@@ -2038,12 +2038,13 @@
;; Extract the file name from WORDS
;; and put t in its place.
;; Later on we will put the modified file name arg back there.
- (file-word (let ((w (cdr words)))
- (while (and w (= ?- (aref (car w) 0)))
- (setq w (cdr w)))
- (and w
- (prog1 (car w)
- (setcar w t)))))
+ (file-word (decode-quote-hexadecimal
+ (let ((w (cdr words)))
+ (while (and w (= ?- (aref (car w) 0)))
+ (setq w (cdr w)))
+ (and w
+ (prog1 (car w)
+ (setcar w t))))))
(file-subst
(and file-word (substitute-in-file-name file-word)))
(args (cdr words))
@@ -2088,6 +2089,27 @@
(set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
(gud-set-buffer))
+(defun encode-space-quote-hexadecimal (str)
+ "encode space and tab characters in string STR using the URL encoding style such as %20."
+ (let (str2)
+ (while (string-match "\\([ \t]\\)" str)
+ (setq str2
+ (concat str2 (substring str 0 (match-beginning 1))
+ "%"
+ (format "%02x" (string-to-char (substring str (match-beginning 1) (match-end 1))))))
+ (setq str (substring str (match-end 1))))
+ (concat str2 str)))
+
+(defun decode-quote-hexadecimal (str)
+ "decode the URL encoding style byte representation %<hexadecimal value> in string STR."
+ (let (str2)
+ (while (string-match "%\\([0-9][0-9]\\)" str)
+ (setq str2
+ (concat str2 (substring str 0 (1- (match-beginning 1)))
+ (format "%c" (string-to-number (substring str (match-beginning 1) (match-end 1)) 16))))
+ (setq str (substring str (match-end 1))))
+ (concat str2 str)))
+
(defun gud-set-buffer ()
(when (eq major-mode 'gud-mode)
(setq gud-comint-buffer (current-buffer))))
Solution 2
--- gud.original.el 2002-10-24 22:07:56.000000000 +0900
+++ gud_2.el 2003-06-27 18:40:34.000000000 +0900
@@ -1286,7 +1286,10 @@
and source-file directory for your debugger."
(interactive
(list (gud-query-cmdline 'perldb
- (concat (or (buffer-file-name) "-e 0") " "))))
+ (concat (or (if (string-match " " (buffer-file-name))
+ (concat "\"" (buffer-file-name) "\"")
+ (buffer-file-name))
+ "-e 0") " "))))
(gud-common-init command-line 'gud-perldb-massage-args
'gud-perldb-marker-filter 'gud-perldb-find-file)
@@ -2033,7 +2036,7 @@
;; The other three args specify the values to use
;; for local variables in the debugger buffer.
(defun gud-common-init (command-line massage-args marker-filter &optional find-file)
- (let* ((words (split-string command-line))
+ (let* ((words (split-string-escape-dq command-line))
(program (car words))
;; Extract the file name from WORDS
;; and put t in its place.
@@ -2045,7 +2048,8 @@
(prog1 (car w)
(setcar w t)))))
(file-subst
- (and file-word (substitute-in-file-name file-word)))
+ (and file-word
+ (remove-surrounding-dq (substitute-in-file-name file-word))))
(args (cdr words))
;; If a directory was specified, expand the file name.
;; Otherwise, don't expand it, so GDB can use the PATH.
@@ -2088,6 +2092,67 @@
(set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
(gud-set-buffer))
+(defun split-string-escape-dq (string &optional separators)
+ (let ((rexp (or separators "[ \f\t\n\r\v]+"))
+ (dq "\"") (dq-positions nil) dq-start start-looking
+ (start 0)
+ notfirst
+ (list nil))
+ (while (string-match dq string start)
+ (setq dq-positions (cons (match-beginning 0) dq-positions))
+ (setq start (match-end 0)))
+ (setq dq-positions (append (nreverse dq-positions) (list (1+ (length string)))))
+ (setq start 0)
+ (setq start-looking start)
+ (while dq-positions
+ (setq dq-start (car dq-positions))
+ (when (eq start-looking dq-start)
+ (setq dq-positions (cdr dq-positions))
+ (if dq-positions
+ (and (setq start-looking (car dq-positions))
+ (setq dq-positions (cdr dq-positions))
+ (setq dq-start (car dq-positions))
+ (< start-looking (length string))
+ (setq start-looking (1+ start-looking)))
+ (setq start-looking (lenght string))
+ (setq dq-start (1+ (lenght string)))))
+ (while (and (< start-looking dq-start)
+ (string-match rexp string
+ (if (and notfirst
+ (= start-looking (match-beginning 0))
+ (< start-looking (length string)))
+ (1+ start-looking) start-looking))
+ (< (match-beginning 0) (length string)))
+ (when (<= (match-end 0) dq-start)
+ (progn
+ (setq notfirst t)
+ (or (eq (match-beginning 0) 0)
+ (and (eq (match-beginning 0) (match-end 0))
+ (eq (match-beginning 0) start-looking))
+ (setq list
+ (cons (substring string start (match-beginning 0))
+ list)))
+ (setq start (match-end 0))
+ (setq start-looking start)))
+ (when (>= (match-end 0) dq-start) ;do we need this clause ?
+ (setq dq-positions (cdr dq-positions))
+ (if dq-positions
+ (setq start-looking (car dq-positions))
+ (setq start-looking dq-start)))
+ )
+ (setq dq-positions (cdr dq-positions)))
+ (or (eq start (length string))
+ (setq list
+ (cons (substring string start)
+ list)))
+ (nreverse list)))
+
+(defun remove-surrounding-dq (string)
+ (if (and (= ?\" (aref string 0))
+ (= ?\" (aref string (1- (length string)))))
+ (substring string 1 (1- (length string)))
+ string))
+
(defun gud-set-buffer ()
(when (eq major-mode 'gud-mode)
(setq gud-comint-buffer (current-buffer))))
Best regards,
Taro
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2003-06-27 10:30 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-06-27 10:30 perldb (in gud.el) aborts for a Perl script when its path includes whitespace Taro Kawagishi
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).