[slime-devel] xref

[Andras Simon]

ABCL doesn't yet know about the long form of defsetf, used in xref.lisp. Do
clispers (the only users of xref in slime) have anything against the patch
below? It seems to work in clisp, but I'm no defsetf expert, so I'd rather ask
before committing.

Andras

===================================================================
RCS file: /project/slime/cvsroot/slime/xref.lisp,v
retrieving revision 1.2
diff -u -r1.2 xref.lisp
--- xref.lisp	17 May 2004 00:25:24 -0000	1.2
+++ xref.lisp	17 Sep 2004 20:40:15 -0000
@@ -736,14 +736,14 @@
     (:callers (gethash name *callers-database*))
     (:readers (gethash name *readers-database*))
     (:setters (gethash name *setters-database*))))
-(defsetf callers-list (name &optional (database :callers)) (caller)
-  `(setf (gethash ,name (case ,database
-			  (:file    *file-callers-database*)
-			  (:callees *callees-database*)
-			  (:callers *callers-database*)
-			  (:readers *readers-database*)
-			  (:setters *setters-database*)))
-	 ,caller))
+
+(defun (setf callers-list) (val name &optional (database :callers))
+  (setf (gethash name (case database
+			(:file *file-callers-database*)
+			(:callees *callees-database*)
+			(:callers *callers-database*)
+			(:readers *readers-database*)
+			(:setters *setters-database*))) val))

 (defun list-callers (symbol)
   "Lists all functions which call SYMBOL as a function (function invocation)."
@@ -788,9 +788,10 @@
 (defun source-file (symbol)
   "Lists the names of files in which SYMBOL is defined/used."
   (gethash symbol *source-file*))
-(defsetf source-file (name) (value)
-  `(setf (gethash ,name *source-file*) ,value))

+(defun (setf source-file) (value name)
+  (setf (gethash name *source-file*) value))
+
 (defun clear-tables ()
   (clrhash *file-callers-database*)
   (clrhash *callers-database*)
@@ -807,9 +808,10 @@
 (defvar *pattern-caller-type* (make-hash-table :test #'equal))
 (defun pattern-caller-type (name)
   (gethash name *pattern-caller-type*))
-(defsetf pattern-caller-type (name) (value)
-  `(setf (gethash ,name *pattern-caller-type*) ,value))

+(defun (setf pattern-caller-type) (value name)
+  (setf (gethash name *pattern-caller-type*) value))
+
 ;;; Pattern Substitutions
 (defvar *pattern-substitution-table* (make-hash-table :test #'equal)
   "Stores general patterns for function destructuring.")
@@ -1267,6 +1269,7 @@
    database. (For large systems it can take a long time to crunch
    through the code, so this can save some time.)"
   (with-open-file (stream filename :direction :output)
+    (format stream "~&(in-package :pxref)")
     (format stream "~&(clear-tables)")
     (maphash #'(lambda (x y)
 		 (format stream "~&(setf (source-file '~S) '~S)"