perldb (in gud.el) aborts for a Perl script when its path includes whitespace

[Taro Kawagishi]

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