home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / Emacs-cl-shell / source-file-extensions.lisp < prev    next >
Encoding:
Text File  |  1991-03-08  |  7.0 KB  |  167 lines
  1. ;;; Extensions to Lucid's source file recording capabilities.  These
  2. ;;; are meant for use with the Emacs code in cl-lucid.el, although
  3. ;;; they do not depend on that code in any way.  The converse is also
  4. ;;; true: the code in cl-lucid.el does not depend on this code in any
  5. ;;; way.
  6.  
  7. ;;; We extend Lucid's source-file recording mechanism to allow Emacs
  8. ;;; to tell the user about different definitions and find them in
  9. ;;; source files.  We are particularly interested in extending to
  10. ;;; cover objects systems (Flavors and CLOS) and functions defined by
  11. ;;; side-effect (such as through defstruct or defclass). There are two
  12. ;;; ways to do this:
  13.  
  14. ;;; 1) Use the type argument to record-source-file to store
  15. ;;; information which Emacs can use to determine a regexp to search
  16. ;;; for in the source file.  On the CL side, this is the simplest
  17. ;;; solution.  The loss is that it screws up redefinition warnings
  18. ;;; between different types of definition (eg: structure accessors and
  19. ;;; normal functions).  This is partly because lucid only compares the
  20. ;;; type slots with eq, so lists are not compared correctly.  Code
  21. ;;; could be written to check for the appropriate collisions, but this
  22. ;;; seems tricky.
  23.  
  24. ;;; 2) Store auxilliary source-file information on the symbol plist,
  25. ;;; and provide a new function to access this.  Emacs will call this
  26. ;;; function instead of get-source-file.  The advantage is that this
  27. ;;; doesn't interfere with the existing source file recording
  28. ;;; mechanism.  The loss is that it requires additional CL code that
  29. ;;; Emacs must rely on, and it is hard to tie in the existing
  30. ;;; source-file list.
  31.  
  32. ;;; We opt for the simplicity of the first approach.  To add
  33. ;;; source-file-recording for a new type of object/function, the user
  34. ;;; just calls record-source-file with a list.  To tell Emacs how to
  35. ;;; find definitions for this object/function, see instructions in
  36. ;;; cl-lucid.el.
  37.  
  38. #-:Lucid
  39. (error "The code in this file depends on Lucid's source-file \
  40. extensions to Common Lisp.")
  41.  
  42. (in-package 'lucid)
  43.  
  44. ;;;; ----------------------- Common Lisp ------------------------
  45.  
  46. ;;; If non-nil, this should be a list of pairs.  If the type arg to
  47. ;;; record-source-file matches the car of a pair, the cdr will be
  48. ;;; substituted.  This is used to ensure that definitions produced by
  49. ;;; side-effect (such as defstruct accessors) can be found by the
  50. ;;; editor.
  51. (defvar *definition-type-replacements* nil)
  52.  
  53. ;;; BUG: *** this should behave according to *redefinition-action*,
  54. ;;; giving warnings when necessary.  Also, the default
  55. ;;; record-source-file re-records source file if a new-type-pair is
  56. ;;; found (i.e. if the new type arg is not a symbol, the source file
  57. ;;; list is extended to contain the new def as well as the old).
  58. (defadvice (lucid::record-source-file side-effect-extension)
  59.     (object type &rest options)
  60.   (let ((new-type-pair (assoc type *definition-type-replacements* :test #'equal))
  61.     old-source-file-pair)
  62.     (cond (new-type-pair
  63.        (setq old-source-file-pair (assoc (cdr new-type-pair)
  64.                          (get-source-file object nil t)
  65.                          :test #'equal))
  66.        (if (and old-source-file-pair
  67.             (equal (cdr old-source-file-pair) (car options)))
  68.            t            ;don't re-record same source file
  69.            (apply-advice-continue object (cdr new-type-pair) options)))
  70.        (t (apply-advice-continue object type options)))))
  71.  
  72. ;;; We set up defvar, defparameter, defconstant, and deftype to record
  73. ;;; source files with the type matching that used for the
  74. ;;; documentation function.  These were left out of Lucid 3.0, but
  75. ;;; they are already taken care of in Lucid 4.0.
  76. #-LCL4.0
  77. (defadvice (defvar record-source-file) (form &optional env)
  78.   `(progn
  79.      (record-source-file ',(second form) 'variable)
  80.      ,(advice-continue form env)))
  81.  
  82. #-LCL4.0
  83. (defadvice (defconstant record-source-file) (form &optional env)
  84.   `(progn
  85.      (record-source-file ',(second form) 'variable)
  86.      ,(advice-continue form env)))
  87.  
  88. #-LCL4.0
  89. (defadvice (defparameter record-source-file) (form &optional env)
  90.   `(progn
  91.      (record-source-file ',(second form) 'variable)
  92.      ,(advice-continue form env)))
  93.  
  94. ;;; Put in source file recording for types.
  95. (defadvice (deftype record-source-file) (form &optional env)
  96.   `(progn
  97.      (record-source-file ',(second form) 'type)
  98.      ,(advice-continue form env)))
  99.  
  100. ;;; Alter defstruct to store source file for constructor and slot
  101. ;;; accessors, as well as the structure itself.  Ordinarily, Lucid
  102. ;;; would record source file info for constructor and slot accessors.
  103. ;;; But in order for the editor to find the definitions, we need to
  104. ;;; indicate that it should look for a defstruct in the source file.
  105. ;;; We do this by replacing the 'function type argument to
  106. ;;; record-source-file with the list '(:struct-function <struct-name>).
  107. (defadvice (defstruct record-source-file) (form &optional env)
  108.   (destructuring-bind (defstruct name-and-options &body slot-descriptions) form
  109.     (declare (ignore defstruct slot-descriptions))
  110.     (let* ((name (if (listp name-and-options)
  111.            (first name-and-options)
  112.            name-and-options)))
  113.       `(let ((*definition-type-replacements*
  114.           '((function . (:struct-function ,name)))))
  115.     ,(advice-continue form env)))))
  116.  
  117. ;;; Unfortunately, have to do this to prevent redefinition warning
  118. ;;; messages from breaking when the type is a list.  This problem has
  119. ;;; been fixed in Lucid 4.0!
  120. #-LCL4.0
  121. (defadvice (lisp:string list-extension) (thing)
  122.   (when (listp thing) (setq thing (format nil "~S" thing)))
  123.   (advice-continue thing))
  124.          
  125. ;;;; ----------------------- PCL -------------------------
  126.  
  127. ;;; *** Need to add a pair to the *definition-type-replacements* list for
  128. ;;; accessors!
  129. #+:PCL
  130. (defadvice (pcl:defclass record-source-file) (form &optional env)
  131.   `(progn
  132.     (record-source-file ',(cadr form) ':class)
  133.     ,(advice-continue form env)))
  134.  
  135. ;;; We record the type arg of a pcl method as '(:method . arg-classes)
  136. #+:PCL
  137. (defadvice (pcl:defmethod record-source-file) (form &optional env)
  138.   (destructuring-bind (defmethod name qualifiers arglist &body body) form
  139.     (declare (ignore defmethod body))
  140.     (let ((arg-classes (loop for arg in (if (listp qualifiers) qualifiers arglist)
  141.                  until (not (listp arg))
  142.                  collect (cadr arg))))
  143.       `(progn
  144.     (record-source-file ',name ',(cons ':method arg-classes))
  145.     ,(advice-continue form env)))))
  146.  
  147. ;;;; --------------------- Flavors --------------------------
  148.  
  149. #+:FLAVORS
  150. (defadvice (flavors:defflavor record-source-file) (form &optional env)
  151.   `(progn
  152.      (record-source-file ',(second form) :flavor *source-pathname*)
  153.      ,(advice-continue form env)))
  154.  
  155. ;;; We record the type arg of a flavors method as '(:method <flavor> <type>)
  156. #+:FLAVORS
  157. (defadvice (flavors:defmethod record-source-file) (form &optional env)
  158.   (destructuring-bind (defmethod (flavor type &optional method) &body body) form
  159.     (declare (ignore defmethod body))
  160.     (when (null method)            ;type may be omitted, defaults to :primary
  161.       (setq method type 
  162.         type :primary))
  163.     `(progn
  164.        (record-source-file ',method '(:method ,flavor ,type))
  165.       ,(advice-continue form env))))
  166.  
  167.