[slime-cvs] CVS slime/contrib

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv21639/contrib

Modified Files:
	swank-asdf.lisp slime-asdf.el ChangeLog 
Log Message:
	Add 'M-x slime-query-replace-system-and-dependencies' which is
	like `slime-query-replace-system' but also runs query-replace on
	all files of systems _depending on_ the user-queried system.

	* slime-asdf.el (slime-read-query-replace-args): Factored out from
	`slime-query-replace-system'.
	(slime-query-replace-system): Use it.
	(slime-query-replace-system-and-dependencies): Add.

	* swank-asdf.lisp (who-depends-on):
	`asdf:system-definition-pathname' may return NIL, guard against
	that.


--- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/12/17 10:30:31	1.23
+++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp	2009/12/18 19:47:55	1.24
@@ -40,12 +40,13 @@
 (defmethod xref-doit ((type (eql :depends-on)) thing)
   (loop for dependency in (who-depends-on thing)
         for asd-file = (asdf:system-definition-pathname dependency)
-        collect (list dependency
-                      (swank-backend::make-location
-                       `(:file ,(namestring asd-file))
-                       `(:position 1)
-                       `(:snippet ,(format nil "(defsystem :~A" dependency)
-                         :align t)))))
+        when asd-file
+          collect (list dependency
+                        (swank-backend::make-location
+                         `(:file ,(namestring asd-file))
+                         `(:position 1)
+                         `(:snippet ,(format nil "(defsystem :~A" dependency)
+                           :align t)))))
 
 
 (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
--- /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/12/17 10:30:31	1.23
+++ /project/slime/cvsroot/slime/contrib/slime-asdf.el	2009/12/18 19:47:55	1.24
@@ -155,19 +155,43 @@
       (interactive)
       (error "This command is only supported on GNU Emacs >23.1.x.")))
 
+(defun slime-read-query-replace-args (format-string &rest format-args)
+  (let* ((minibuffer-setup-hook (slime-minibuffer-setup-hook))
+         (minibuffer-local-map slime-minibuffer-map)
+         (common (query-replace-read-args (apply #'format format-string
+                                                 format-args)
+                                          t t)))
+    (list (nth 0 common) (nth 1 common) (nth 2 common))))
+
 (defun slime-query-replace-system (name from to &optional delimited)
   "Run `query-replace' on an ASDF system."
-  (interactive 
-   (let* ((minibuffer-setup-hook (slime-minibuffer-setup-hook))
-	  (minibuffer-local-map slime-minibuffer-map)
-	  (system (slime-read-system-name nil nil t))
-          (common (query-replace-read-args 
-                   (format "Query replace throughout `%s'" system) t t)))
-     (list system (nth 0 common) (nth 1 common) (nth 2 common))))
-  ;; `tags-query-replace' actually uses `query-replace-regexp'
-  ;; internally.
-  (tags-query-replace (regexp-quote from) to delimited
-		      '(slime-eval `(swank:asdf-system-files ,name))))
+  (interactive (let ((system (slime-read-system-name nil nil t)))
+                 (cons system (slime-read-query-replace-args
+                               "Query replace throughout `%s'" system))))
+  (condition-case c
+      ;; `tags-query-replace' actually uses `query-replace-regexp'
+      ;; internally.
+      (tags-query-replace (regexp-quote from) to delimited
+                          '(slime-eval `(swank:asdf-system-files ,name)))
+    (error
+     ;; Kludge: `tags-query-replace' does not actually return but
+     ;; signals an unnamed error with the below error
+     ;; message. (<=23.1.2, at least.)
+     (unless (string-equal (error-message-string c) "All files processed")
+       (signal (car c) (cdr c)))        ; resignal
+     t)))
+
+(defun slime-query-replace-system-and-dependencies
+    (name from to &optional delimited)
+  "Run `query-replace' on an ASDF system."
+  (interactive (let ((system (slime-read-system-name nil nil t)))
+                 (cons system (slime-read-query-replace-args
+                               "Query replace throughout `%s'+dependencies"
+                               system))))
+  (slime-query-replace-system name from to delimited)
+  (dolist (dep (slime-who-depends-on-rpc name))
+    (when (y-or-n-p (format "Descend into system `%s'? " dep))
+      (slime-query-replace-system dep from to delimited))))
 
 (defun slime-delete-system-fasls (name)
   "Delete FASLs produced by compiling a system."
--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/12/17 10:30:31	1.307
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/12/18 19:47:55	1.308
@@ -1,3 +1,18 @@
+2009-12-18  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Add 'M-x slime-query-replace-system-and-dependencies' which is
+	like `slime-query-replace-system' but also runs query-replace on
+	all files of systems _depending on_ the user-queried system.
+
+	* slime-asdf.el (slime-read-query-replace-args): Factored out from
+	`slime-query-replace-system'.
+	(slime-query-replace-system): Use it.
+	(slime-query-replace-system-and-dependencies): Add.
+
+	* swank-asdf.lisp (who-depends-on):
+	`asdf:system-definition-pathname' may return NIL, guard against
+	that.
+
 2009-12-17  Tobias C. Rittweiler  <tcr at freebits.de>
 
 	* swank-asdf.lisp (who-depends-on): Make defslimefun.