cgit.sxemacs.org Git - packages/blob - xemacs-packages/jde/lisp/jde-class.el

   1 ;; JDE-CLASS.EL --- Class usage commands for the JDEE.
   2 ;; $Revision: 1.6 $
   3 ;;
   4 ;; Copyright (C) 2003 Andrew Hyatt
   5 ;;
   6 ;; Author: Andrew Hyatt <andy_jde@thehyatts.net>
   7 ;; Maintainers: Andrew Hyatt and Paul Kinnucan
   8 ;; Keywords: java, tools
   9 ;;
  10 ;;
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; A copy of the GNU General Public License can be obtained from this
  22 ;; program's author (send electronic mail to
  23 ;; ) or from the Free Software
  24 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  25 ;; $Date: 2003/07/15 06:03:13 $
  26
  27 ;;; Commentary:
  28 ;;;
  29 ;;;This is a package that contains various utility classes that are
  30 ;;; useful when dealing with class files.  There are several macros to
  31 ;;; enable one to write code that looks through all compiled class
  32 ;;; files, such as `with-all-class-files', which calls some code for
  33 ;;; every class files in the `jde-built-class-path'.  There is also
  34 ;;; `with-all-class-infos-when', which tests each class file with some
  35 ;;; predicate, and if it passes then makes the class-info available to
  36 ;;; the code in the body.  `with-all-corresponding-class-infos' will
  37 ;;; execte for classes that are compiled from a certain Java source file.
  38 ;;;
  39 ;;; There are also a few helper utilities here.
  40
  41 (require 'jde-parse-class)
  42
  43 (defcustom jde-built-class-path nil
  44   "Similar to `jde-global-classpath', except this path should only
  45 have those places where compile files live.  This list of paths could
  46 contain both directories and jar files.  Each of these should
  47 correspond to the root of the build tree, in other words the
  48 directories under it should correpond to packages."
  49   :group 'jde-project
  50   :type '(repeat (file :tag "Path")))
  51
  52 (defmacro with-all-class-files (spec &rest body)
  53   "Call BODY for every class file found in `jde-built-class-path'.
  54 Pass in the variable that the class filename will be substituted for,
  55 and optionally a value to use as the return value (similar to
  56 `dotimes'), otherwise `nil' will be returned.  Another optional
  57 argument in the SPEC is the package to restrict processing to.
  58
  59 \(fn (VAR [RESULT] [PACKAGE]) BODY...)"
  60
  61   (let ((class-var-sym (car spec))
  62         (old-dir-sym (gensym "--with-all-class-files-old-dir"))
  63         (normalized-path-sym (gensym "--with-all-class-files-npath"))
  64         (dir-sym (gensym "--with-all-class-files-dir-sym"))
  65         (dir2-sym (gensym "--with-all-class-files-dir2-sym"))
  66         (path-sym (gensym "--with-all-class-files-path"))
  67         (buf-sym (gensym "--with-all-class-files-buf"))
  68         (rec-descend (gensym "--with-all-class-files-rec-descend"))
  69         (process-files (gensym "--with-all-class-files-process-files"))
  70         (process-class (gensym "--with-all-class-files-process-class"))
  71         (child-path (gensym "--with-all-class-files-child-path"))
  72         (package (nth 2 spec)))
  73         `(labels ((,process-class (,class-var-sym)
  74                                  (when (string-match "\.[Cc][Ll][Aa][Ss][Ss]$" ,class-var-sym)
  75                                    ,@body))
  76                   (,process-files (,dir2-sym)
  77                                   (when (file-exists-p ,dir2-sym)
  78                                         (dolist (,class-var-sym (directory-files ,dir2-sym
  79                                                                                  t "[^.]$"))
  80                                           (,process-class ,class-var-sym))))
  81                   (,rec-descend (,dir2-sym)
  82                                 (if (file-directory-p ,dir2-sym)
  83                                     (dolist (,child-path (directory-files ,dir2-sym
  84                                                                          t "[^.]$"))
  85                                       (,rec-descend ,child-path))
  86                                   (,process-class ,dir2-sym))))
  87            (let ((,old-dir-sym default-directory))
  88              (unwind-protect
  89                  (save-excursion
  90                    (dolist (,path-sym jde-built-class-path)
  91                      (let ((,normalized-path-sym (jde-normalize-path ,path-sym)))
  92                        (unless (file-exists-p ,normalized-path-sym)
  93                          (error (concat "Could not find file or directory "
  94                                         ,normalized-path-sym)))
  95                        (if (file-directory-p ,normalized-path-sym)
  96                            (if ,package
  97                                (,process-files
  98                                 (concat ,normalized-path-sym "/" (subst-char-in-string ?. ?/ ,package)))
  99                              (,rec-descend ,normalized-path-sym))
 100                          ;; we're not a directory, assume we are a jar file
 101                          (let ((,dir-sym (concat (jde-temp-directory) "/"
 102                                                  (make-temp-name "jde-classes-temp"))))
 103                            (make-directory ,dir-sym)
 104                            (cd ,dir-sym)
 105                            (let ((,buf-sym (get-buffer-create "*Jar output*")))
 106                              (unless (eq (call-process (jde-get-jdk-prog 'jar) nil
 107                                                        ,buf-sym nil "-xf"
 108                                                        (expand-file-name
 109                                                         ,normalized-path-sym)) 0)
 110                                (error
 111                                 (concat "Could not unjar file "
 112                                         (expand-file-name ,normalized-path-sym)
 113                                         ".  See *Jar output* buffer for details")))
 114                              (kill-buffer ,buf-sym))
 115                            (unwind-protect
 116                                (if ,package
 117                                    (,process-files
 118                                     (concat ,dir-sym "/" (subst-char-in-string ?. ?/ ,package)))
 119                                  (,rec-descend ,dir-sym))
 120                              (jde-remove-all-from-directory ,dir-sym)))))))
 121                (cd ,old-dir-sym)))
 122            ;; return val
 123            ,(nth 1 spec))))
 124
 125 (defmacro with-all-class-infos-when (spec pred &rest body)
 126   "Call BODY with the parsed class information of each file found in
 127 `jde-built-class-path' which passes PRED.  PRED is called on the file
 128 name, not the info.  Also, in contrast to `with-all-classes', the BODY
 129 won't get called on the same class twice.  Pass in the variable that
 130 the class info will be substituted for, and optionally a value to use
 131 as the return value (similar to `dotimes').  Otherwise `nil' will be
 132 returned.  The second optional parameter is the optional package
 133 parameter, to restrict processing to a particular package.
 134 Example:(with-all-class-infos-when (info) (lambda (x)
 135 (some-pred-p x)) (do-stuff info))"
 136
 137 (let ((parsed-class-sym (gensym "--with-all-class-infos-pclasses"))
 138       (class-file-sym (gensym "--with-all-class-infos-cfile"))
 139       (var-sym (car spec)))
 140   `(let ((,parsed-class-sym '()))
 141      (with-all-class-files (,class-file-sym ,@(cdr spec))
 142                            (when (and (not (jde-class-path-in-classes-p ,class-file-sym ,parsed-class-sym))
 143                                       (funcall ,pred ,class-file-sym))
 144                              (let ((,var-sym (jde-parse-class ,class-file-sym)))
 145                                ,@body
 146                                (add-to-list (quote ,parsed-class-sym)
 147                                             (jde-parse-class-extract-classname info)))))
 148      ,(cadr spec))))
 149
 150 (defmacro with-all-corresponding-class-infos (spec &rest body)
 151   "Do BODY with all the class files that correspond to the given
 152 source file.  SPEC is a list of the variable name to store the class
 153 info, the package name of the source file, the source name of the source file, and the optional return val.
 154 \((with-all-corresponding-class-infos (VAR PACKAGE FILENAME [RESULT]) BODY...)"
 155   `(with-all-class-infos-when (,(nth 0 spec) ,(nth 3 spec) ,(nth 1 spec))
 156      (lambda (class-file)
 157        (string-match ,(nth 1 spec)
 158                      (replace-regexp-in-string "/" "." (file-name-directory class-file))))
 159      (when (equal (jde-parse-class-extract-sourcefile info) ,(nth 2 spec))
 160        ,@body)))
 161
 162 (defun jde-class-path-in-classes-p (path classes)
 163   "Returns true if the PATH looks like it represents a class in CLASSES"
 164   (jde-class-partial-match-member
 165    (replace-regexp-in-string "\\.[Cc][Ll][Aa][Ss][Ss]$" ""
 166                              (replace-regexp-in-string "/\\|\\$" "." path))
 167    classes))
 168
 169 (defun jde-class-partial-match-member (str list)
 170   "Like `member' but works with strings and will return true if any of
 171 the strings in LIST exist at the end of STR"
 172   (member-if (lambda (item) (string-match (concat (regexp-quote item) "$")
 173                                           str)) list))
 174
 175 (defun jde-remove-all-from-directory (dir)
 176   (if (file-directory-p dir)
 177     (progn
 178       (mapcar 'jde-remove-all-from-directory
 179               (directory-files dir t "[^\\.]$"))
 180       (delete-directory dir))
 181     (delete-file dir)))
 182
 183 (defun append-to-list (var list &optional accept-nil)
 184   "Appends everything in LIST to the list in VAR.  Use similar to
 185 add-to-list, but instead of adding one things, adds a bunch.
 186 ACCEPT-NIL determines if 'nil's are to be added.  By default, they
 187 will not be."
 188   (dolist (item list)
 189     (when (or accept-nil item)
 190       (add-to-list var item))))
 191
 192 (defun jde-class-get-all-classes-used-by-source (package source-file)
 193   (let ((primitives '("boolean" "int" "void" "float" "double"))
 194         (classes '()))
 195     (with-all-corresponding-class-infos (info package source-file classes)
 196                                         ;;a. super class type
 197                                         (add-to-list 'classes (jde-parse-class-extract-superclass info))
 198                                         ;;b. super interfaces type
 199                                         (append-to-list 'classes (jde-parse-class-extract-interfaces info))
 200                                         ;;c. types of declared fields
 201                                         ;;d. local variable types
 202                                         ;; (all called types should wrk for this...)
 203                                         (append-to-list 'classes (mapcar (lambda(item) (caadr item))
 204                                                                          (jde-parse-class-extract-method-calls info)))
 205                                         ;;e. method return type
 206                                         ;;f. method parameter type
 207                                         (dolist (sig (jde-parse-class-extract-method-signatures info))
 208                                           (when (and (nth 1 sig) (not (member (nth 1 sig) primitives)))
 209                                             (add-to-list 'classes (nth 1 sig)))
 210                                           (append-to-list 'classes
 211                                                           (mapcar (lambda (c) (when (and c (not (member c primitives)) c)))
 212                                                                   (nth 2 sig))))
 213                                         ;;g. method exception types
 214                                         (dolist (exceptions (mapcar (lambda (method-exceptions) (nth 1 method-exceptions))
 215                                                                     (jde-parse-class-extract-thrown-exception-types info)))
 216                                           (append-to-list 'classes exceptions))
 217                                         ;;h. type of exceptions in 'catch' statements.
 218                                         (dolist (exceptions (mapcar (lambda (method-exceptions) (nth 1 method-exceptions))
 219                                                                     (jde-parse-class-extract-caught-exception-types info)))
 220                                           (append-to-list 'classes exceptions)))))
 221
 222 (provide 'jde-class)
 223
 224 ;; $Log: jde-class.el,v $
 225 ;; Revision 1.6  2003/07/15 06:03:13  ahyatt
 226 ;; temp-directory was not always defined (in xemacs)
 227 ;;
 228 ;; Revision 1.5  2003/05/10 06:05:57  ahyatt
 229 ;; Fix assorted bugs dealing with with-all-corresponding-class-infos and using with-all-class-files with package specifiers while using jar files.
 230 ;;
 231 ;; Revision 1.4  2003/05/06 06:50:55  ahyatt
 232 ;; Fixes recent regression with default-directory not getting set back after making the xref db (if the jde-built-class-path contains jars)
 233 ;;
 234 ;; Revision 1.3  2003/05/06 05:25:47  ahyatt
 235 ;; Fixed problem with package variable, and the function to recursively delete a directory.
 236 ;;
 237 ;; Revision 1.2  2003/05/03 08:43:41  paulk
 238 ;; Fix typo in with-all-class-files.
 239 ;;
 240 ;; Revision 1.1  2003/03/13 19:06:20  ahyatt
 241 ;; Added CVS tags
 242 ;;