Gud.el Update

[Zoltan Kemenczy]

Enclosed is the changelog and context diff  for an update to lisp/gud.el.
The changes are limited to jdb operation.
The changes add support for jdb's "-sourcepath" option, correct a backward
compatibility problem for the old method of finding source files and correct
the handling of trailing slashes in classpath and sourcepath lists.

The changes are relative to CVS local/gud.el:1.154 (MAIN).

Regards, Zoltan
-----------------
Changelog entry:

2002-03-24    address@hidden

 * gud.el (gud-jdb-sourcepath): new variable, saves jdb -sourcepath
 parameter value.
 (gud-jdb-build-source-files-list): comment clarification.
 (gud-jdb-massage-args): reworked into loop-based argument list
 processing in order to support -classpath and -sourcepath argument
 processing.
 (gud-jdb-find-source-using-classpath): prepend gud-jdb-sourcepath
 to gud-jdb-classpath to obtain search list.
 (gud-jdb-parse-classpath-string): remove any trailing slashes from
 directory names in classpath/sourcepath lists, update comment.
 (jdb): add setting of gud-jdb-sourcepath, update comment.
 (gud-find-class): add gud-jdb-sourcepath use, and correct
 behaviour for the case when classpath is not used - backward
 compatibility fix.
 
*** /tmp/gud.el Sun Mar 24 23:36:25 2002
--- /Zoltan/local/lisp/gud.el Sun Mar 24 23:39:51 2002
***************
*** 1485,1495 ****
  ;; You must not put whitespace between "-classpath" and the path to
  ;; search for java classes even though it is required when invoking jdb
  ;; from the command line.  See gud-jdb-massage-args for details.
  ;;
  ;; Note: The following applies only if `gud-jdb-use-classpath' is nil;
  ;; refer to the documentation of `gud-jdb-use-classpath' and
! ;; `gud-jdb-classpath' variables for information on using the classpath
! ;; for locating java source files.
  ;;
  ;; If any of the source files in the directories listed in
  ;; gud-jdb-directories won't parse you'll have problems.  Make sure
--- 1485,1496 ----
  ;; You must not put whitespace between "-classpath" and the path to
  ;; search for java classes even though it is required when invoking jdb
  ;; from the command line.  See gud-jdb-massage-args for details.
+ ;; The same applies for "-sourcepath".
  ;;
  ;; Note: The following applies only if `gud-jdb-use-classpath' is nil;
  ;; refer to the documentation of `gud-jdb-use-classpath' and
! ;; `gud-jdb-classpath',`gud-jdb-sourcepath' variables for information
! ;; on using the classpath for locating java source files.
  ;;
  ;; If any of the source files in the directories listed in
  ;; gud-jdb-directories won't parse you'll have problems.  Make sure
***************
*** 1551,1556 ****
--- 1552,1562 ----
  Note that method 3 cannot be used with oldjdb (or Java 1 jdb) since
  those debuggers do not support the classpath command. Use 1) or 2).")
  
+ (defvar gud-jdb-sourcepath nil
+   "Directory list provided by an (optional) \"-sourcepath\" option to jdb.
+ This list is prepended to `gud-jdb-classpath' to form the complete
+ list of directories searched for source files.")
+ 
  (defvar gud-marker-acc-max-length 4000
    "Maximum number of debugger output characters to keep.
  This variable limits the size of `gud-marker-acc' which holds
***************
*** 1589,1595 ****
  "Holds temporary classpath values.")
  
  (defun gud-jdb-build-source-files-list (path extn)
! "Return a list of java source files.
  PATH gives the directories in which to search for files with
  extension EXTN.  Normally EXTN is given as the regular expression
   \"\\.java$\" ."
--- 1595,1601 ----
  "Holds temporary classpath values.")
  
  (defun gud-jdb-build-source-files-list (path extn)
! "Return a list of java source files (absolute paths).
  PATH gives the directories in which to search for files with
  extension EXTN.  Normally EXTN is given as the regular expression
   \"\\.java$\" ."
***************
*** 1818,1832 ****
    ;; gud-common-init).  There are more switches like this (for
    ;; instance "-host" and "-password") but I don't care about them
    ;; yet.
-   (if args
        (let (massaged-args user-error)
  
!  (while
!      (and args
!    (not (string-match "-classpath\\(.+\\)" (car args)))
!    (not (setq user-error
!        (string-match "-classpath$" (car args)))))
!    (setq massaged-args (append massaged-args (list (car args))))
     (setq args (cdr args)))
  
   ;; By this point the current directory is all screwed up.  Maybe we
--- 1824,1854 ----
    ;; gud-common-init).  There are more switches like this (for
    ;; instance "-host" and "-password") but I don't care about them
    ;; yet.
        (let (massaged-args user-error)
  
!     (while (and args (not user-error))
!       (cond
!        ((setq user-error (string-match "-classpath$" (car args))))
!        ((setq user-error (string-match "-sourcepath$" (car args))))
!        ((string-match "-classpath\\(.+\\)" (car args))
!         (setq massaged-args
!               (append massaged-args
!                       (list "-classpath")
!                       (list 
!                        (setq gud-jdb-classpath-string
!                              (substring
!                               (car args)
!                               (match-beginning 1) (match-end 1)))))))
!        ((string-match "-sourcepath\\(.+\\)" (car args))
!         (setq massaged-args
!               (append massaged-args
!                       (list "-sourcepath")
!                       (list 
!                        (setq gud-jdb-sourcepath
!                               (substring
!                                (car args)
!                                (match-beginning 1) (match-end 1)))))))
!        (t (setq massaged-args (append massaged-args (list (car args))))))
     (setq args (cdr args)))
  
   ;; By this point the current directory is all screwed up.  Maybe we
***************
*** 1835,1854 ****
   (if user-error
       (progn
         (kill-buffer (current-buffer))
!        (error "Error: Omit whitespace between '-classpath' and its value")))
! 
!  (if args
!      (setq massaged-args
!     (append
!      massaged-args
!      (list "-classpath")
!      (list
!       (setq gud-jdb-classpath-string
!      (substring
!       (car args)
!       (match-beginning 1) (match-end 1))))
!      (cdr args)))
!    massaged-args))))
  
  ;; Search for an association with P, a fully qualified class name, in
  ;; gud-jdb-class-source-alist.  The asssociation gives the fully
--- 1857,1865 ----
   (if user-error
       (progn
         (kill-buffer (current-buffer))
!           (error "Error: Omit whitespace between \
! '-classpath or -sourcepath'\ and its value")))
!     massaged-args))
  
  ;; Search for an association with P, a fully qualified class name, in
  ;; gud-jdb-class-source-alist.  The asssociation gives the fully
***************
*** 1879,1885 ****
                        p)
                       "\\.") "/")
           ".java"))
!        (cplist gud-jdb-classpath)
         found-file)
      (while (and cplist
                  (not (setq found-file
--- 1890,1896 ----
                        p)
                       "\\.") "/")
           ".java"))
!        (cplist (append gud-jdb-sourcepath gud-jdb-classpath))
         found-file)
      (while (and cplist
                  (not (setq found-file
***************
*** 1897,1904 ****
  
  (defun gud-jdb-parse-classpath-string (string)
  "Parse the classpath list and convert each item to an absolute pathname."
!   (mapcar 'file-truename (split-string string
!         (concat "[ \t\n\r,\"" path-separator "]+"))))
  
  ;; See comentary for other debugger's marker filters - there you will find
  ;; important notes about STRING.
--- 1908,1919 ----
  
  (defun gud-jdb-parse-classpath-string (string)
  "Parse the classpath list and convert each item to an absolute pathname."
!   (mapcar (lambda (s) (if (string-match "[/\\]$" s)
!                           (replace-match "" nil nil s) s))
!           (mapcar 'file-truename
!                   (split-string
!                    string
!                    (concat "[ \t\n\r,\"" path-separator "]+")))))
  
  ;; See comentary for other debugger's marker filters - there you will find
  ;; important notes about STRING.
***************
*** 1911,1916 ****
--- 1926,1933 ----
     string))
  
    ;; Look for classpath information until gud-jdb-classpath-string is found
+   ;; (interactive, multiple settings of classpath from jdb
+   ;;  not supported/followed)
    (if (and gud-jdb-use-classpath
             (not gud-jdb-classpath-string)
             (or (string-match "classpath:[ \t[]+\\([^]]+\\)" gud-marker-acc)
***************
*** 2022,2027 ****
--- 2039,2046 ----
  gud, see `gud-mode'."
    (interactive
     (list (gud-query-cmdline 'jdb)))
+   (setq gud-jdb-classpath nil)
+   (setq gud-jdb-sourcepath nil)
  
    ;; Set gud-jdb-classpath from the CLASSPATH environment variable,
    ;; if CLASSPATH is set.
***************
*** 2040,2045 ****
--- 2059,2068 ----
        (setq gud-jdb-classpath
       (gud-jdb-parse-classpath-string gud-jdb-classpath-string)))
    (setq gud-jdb-classpath-string nil)   ; prepare for next
+   ;; If a -sourcepath option was provided, parse it
+   (if gud-jdb-sourcepath
+       (setq gud-jdb-sourcepath
+             (gud-jdb-parse-classpath-string gud-jdb-sourcepath)))
  
    (gud-def gud-break  "stop at %c:%l" "\C-b" "Set breakpoint at current 
line.")
    (gud-def gud-remove "clear %c:%l"   "\C-d" "Remove breakpoint at current 
line")
***************
*** 2058,2066 ****
    (run-hooks 'jdb-mode-hook)
  
    (if gud-jdb-use-classpath
!       ;; Get the classpath information from the debugger (this is much
!       ;; faster) and does not need the constant updating of
!       ;; gud-jdb-directories
        (progn
          (if (string-match "-attach" command-line)
              (gud-call "classpath"))
--- 2081,2087 ----
    (run-hooks 'jdb-mode-hook)
  
    (if gud-jdb-use-classpath
!       ;; Get the classpath information from the debugger
        (progn
          (if (string-match "-attach" command-line)
              (gud-call "classpath"))
***************
*** 2662,2677 ****
  
  (defun gud-find-class (f)
    "Find fully qualified class corresponding to file F.
! This function uses the `gud-jdb-classpath' list to derive a file
  pathname relative to its classpath directory. The values in
  `gud-jdb-classpath' are assumed to have been converted to absolute
  pathname standards using file-truename."
    ;; Convert f to a standard representation and remove suffix
!   (setq f (file-name-sans-extension (file-truename f)))
!   (if gud-jdb-classpath
        (save-match-data
!         (let ((cplist gud-jdb-classpath)
                class-found)
            ;; Search through classpath list for an entry that is
            ;; contained in f
            (while (and cplist (not class-found))
--- 2683,2699 ----
  
  (defun gud-find-class (f)
    "Find fully qualified class corresponding to file F.
! This function uses the `gud-jdb-classpath' (and optional
! `gud-jdb-sourcepath') list(s) to derive a file
  pathname relative to its classpath directory. The values in
  `gud-jdb-classpath' are assumed to have been converted to absolute
  pathname standards using file-truename."
    ;; Convert f to a standard representation and remove suffix
!   (if (and gud-jdb-use-classpath (or gud-jdb-classpath gud-jdb-sourcepath))
        (save-match-data
!         (let ((cplist (append gud-jdb-sourcepath gud-jdb-classpath))
                class-found)
+           (setq f (file-name-sans-extension (file-truename f)))
            ;; Search through classpath list for an entry that is
            ;; contained in f
            (while (and cplist (not class-found))
***************
*** 2685,2693 ****
            (if (not class-found)
               (message "gud-find-class: class for file %s not found!" f))
            class-found))
!     (message "gud-find-class: classpath information not available!")))
  
  (provide 'gud)
  
  ;;; gud.el ends here
- 
--- 2707,2720 ----
            (if (not class-found)
               (message "gud-find-class: class for file %s not found!" f))
            class-found))
!     ;; Not using classpath - try class/source association list
!     (let ((class-found (rassoc f gud-jdb-class-source-alist)))
!       (if class-found
!           (car class-found)
!         (message "gud-find-class: class for file %s not found
!  in gud-jdb-class-source-alist!" f)
!         nil))))
  
  (provide 'gud)
  
  ;;; gud.el ends here