[slime-devel] slime-open-system

[Madhu]

* "Tobias C. Rittweiler" <877huyjukd.fsf at freebits.de> :
Wrote on Wed, 14 Oct 2009 09:36:34 +0200:

| I'm in mid of other stuff, so I'd like to delegate this work to someone
| else who would like to try himself at some elisp hacking.
|
| I'd like to have M-x slime-open-system which would ask me for an asdf
| system, and then open all the files listed in its .asd file.
|

Here is my code for doing that with MK-DEFSYSTEM systems.  I prompt for
system names via the minibuffer, and if the system has recursive
dependencies, I get an sldb prompt asking whether I want to recursively
handle files in the subsystems.  Also I use SWANK::SLIME-EVAL-IN-EMACS
to call find-file, rather than getting a list of files in emacs (for 2
reasons). So I set `slime-enable-evaluate-in-emacs' to `t'

;; Emacs side:
(setq slime-enable-evaluate-in-emacs t)
(defun slime-open-system (&optional system)
  (interactive
   (list (completing-read
          "MK Defsystem: "
          (slime-eval
           `(cl:mapcar 'mk::component-name (mk::defined-systems))))))
  (slime-eval `(swank::open-system ,system)))

;; Lisp side:
(defun swank::open-system (system)
  "Opens the files of a given MK:DEFSYSTEM system in Emacs."
  (swank::mk-map-files
   system (lambda (x)
            (with-simple-restart (skip-this "Skip.")
              (swank::eval-in-emacs
               `(progn
                  (find-file ,(namestring (truename x)))
                  nil ;;  SWANK bug: SWANK::EVAL-IN-EMACS cant handle return
                      ;;  the value of find-file
                  ))))))


(defun swank::mk-map-files (system &optional f)
  ;; One _could_ use mk::*operations-propagate-to-subsystems* instead of
  ;; *recursively-handle-deps* to control what happens on dependencies but the
  ;; default value may not be appropriate.
  (labels ((walk-components (component)
             (declare (special *recursively-handle-deps*))
             (ecase (mk::component-type component)
               ((:file :private-file)
                (let ((src (mk::component-full-pathname component :source)))
                  (if f
                      (funcall f src)
                      (list src))))
               ((:module :system :subsystem :defsystem)
                (let ((deps (mk::component-depends-on component)))
                  (when (and deps (not *recursively-handle-deps*))
                    (restart-case
                        (cerror "Skip deps" "System ~S depends on: ~S."
                                component deps)
                      (recursively-open-deps ()
                        :report "Recursively handle deps."
                        (setq *recursively-handle-deps* t))))
                  (nconc
                   (when (and deps *recursively-handle-deps*)
                     (loop for dep in deps
                           for depsys = (ignore-errors (mk:find-system dep))
                           unless depsys
                           do
                           (warn "Not handling unknown system: ~S." dep)
                           else nconc (walk-components depsys)))
                   (loop for x in (mk::component-components component)
                         nconc (walk-components x))))))))
    (let ((*recursively-handle-deps* nil)
          (system (etypecase system
                    (mk::component
                     (ecase (mk::component-type system)
                       (:defsystem system)))
                    (symbol (mk:find-system system))
                    (string (mk:find-system system)))))
      (declare (special *recursively-handle-deps*))
      (walk-components system))))

--
Madhu