[slime-cvs] CVS slime/contrib

[heller]

Update of /project/slime/cvsroot/slime/contrib
In directory clnet:/tmp/cvs-serv11792/contrib

Modified Files:
	ChangeLog slime-tramp.el 
Log Message:
Move filename translation code to contrib.

* slime.el (slime-find-filename-translators)
(slime-filename-translations): Move to contrib/slime-tramp.el.
(slime-to-lisp-filename-function)
(slime-from-lisp-filename-function): New variables.

* slime-tramp.el (slime-find-filename-translators)
(slime-filename-translations): Move from slime.el.
(slime-tramp-from-lisp-filename, slime-tramp-to-lisp-filename):
New functions.

--- /project/slime/cvsroot/slime/contrib/ChangeLog	2008/03/14 14:39:36	1.100
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2008/03/18 13:21:28	1.101
@@ -24,6 +24,15 @@
 	silently ignore symbols that can't be usefully classified, but
 	group them under "MISC".
 
+2008-03-14  Helmut Eller  <heller at common-lisp.net>
+
+	Move filename translation code to contrib.
+
+	* slime-tramp.el (slime-find-filename-translators)
+	(slime-filename-translations): Move from slime.el.
+	(slime-tramp-from-lisp-filename, slime-tramp-to-lisp-filename):
+	New functions.
+
 2008-03-08  Helmut Eller  <heller at common-lisp.net>
 
 	Don't blindly override the inspect method for functions.
--- /project/slime/cvsroot/slime/contrib/slime-tramp.el	2007/09/04 10:18:44	1.2
+++ /project/slime/cvsroot/slime/contrib/slime-tramp.el	2008/03/18 13:21:28	1.3
@@ -11,9 +11,56 @@
 ;;   (add-hook 'slime-load-hook (lambda () (require 'slime-tramp)))
 ;;
 
+(require 'tramp)
+
+(defcustom slime-filename-translations nil
+  "Assoc list of hostnames and filename translation functions.  
+Each element is of the form (HOSTNAME-REGEXP TO-LISP FROM-LISP).
+
+HOSTNAME-REGEXP is a regexp which is applied to the connection's
+slime-machine-instance. If HOSTNAME-REGEXP maches then the
+corresponding TO-LISP and FROM-LISP functions will be used to
+translate emacs filenames and lisp filenames.
+
+TO-LISP will be passed the filename of an emacs buffer and must
+return a string which the underlying lisp understandas as a
+pathname. FROM-LISP will be passed a pathname as returned by the
+underlying lisp and must return something that emacs will
+understand as a filename (this string will be passed to
+find-file).
+
+This list will be traversed in order, so multiple matching
+regexps are possible.
+
+Example:
+
+Assuming you run emacs locally and connect to slime running on
+the machine 'soren' and you can connect with the username
+'animaliter':
+
+  (push (list \"^soren$\"
+              (lambda (emacs-filename)
+                (subseq emacs-filename (length \"/ssh:animaliter at soren:\")))
+              (lambda (lisp-filename)
+                (concat \"/ssh:animaliter at soren:\" lisp-filename)))
+        slime-filename-translations)
+
+See also `slime-create-filename-translator'."
+  :type '(repeat (list :tag "Host description"
+                       (regexp :tag "Hostname regexp")
+                       (function :tag "To   lisp function")
+                       (function :tag "From lisp function")))
+  :group 'slime-lisp)
+
+(defun slime-find-filename-translators (hostname)
+  (cond ((and hostname slime-filename-translations)
+         (or (cdr (assoc-if (lambda (regexp) (string-match regexp hostname))
+                            slime-filename-translations))
+             (error "No filename-translations for hostname: %s" hostname)))
+        (t (list #'identity #'identity))))
+
 (defun slime-make-tramp-file-name (username remote-host lisp-filename)
   "Old (with multi-hops) tramp compatability function"
-  (require 'tramp)
   (if (boundp 'tramp-multi-methods)
       (tramp-make-tramp-file-name nil nil
                                   username
@@ -52,4 +99,15 @@
              ,remote-host
              lisp-filename)))))
 
+(defun slime-tramp-to-lisp-filename (filename)
+  (funcall (first (slime-find-filename-translators (slime-machine-instance)))
+           (expand-file-name filename)))
+
+(defun slime-tramp-from-lisp-filename (filename)
+  (funcall (second (slime-find-filename-translators (slime-machine-instance)))
+           filename))
+
+(setq slime-to-lisp-filename-function #'slime-tramp-to-lisp-filename)
+(setq slime-from-lisp-filename-function #'slime-tramp-from-lisp-filename)
+
 (provide 'slime-tramp)
\ No newline at end of file