dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

sly-tramp.el (4864B)

      1 ;; -*- lexical-binding: t; -*-
      2 (require 'sly)
      3 (require 'tramp)
      4 (require 'cl-lib)
      5 
      6 (define-sly-contrib sly-tramp
      7   "Filename translations for tramp"
      8   (:authors "Marco Baringer <mb@bese.it>")
      9   (:license "GPL")
     10   (:on-load 
     11    (setq sly-to-lisp-filename-function #'sly-tramp-to-lisp-filename)
     12    (setq sly-from-lisp-filename-function #'sly-tramp-from-lisp-filename)))
     13 
     14 (defcustom sly-filename-translations nil
     15   "Assoc list of hostnames and filename translation functions.  
     16 Each element is of the form (HOSTNAME-REGEXP TO-LISP FROM-LISP).
     17 
     18 HOSTNAME-REGEXP is a regexp which is applied to the connection's
     19 sly-machine-instance. If HOSTNAME-REGEXP maches then the
     20 corresponding TO-LISP and FROM-LISP functions will be used to
     21 translate emacs filenames and lisp filenames.
     22 
     23 TO-LISP will be passed the filename of an emacs buffer and must
     24 return a string which the underlying lisp understandas as a
     25 pathname. FROM-LISP will be passed a pathname as returned by the
     26 underlying lisp and must return something that emacs will
     27 understand as a filename (this string will be passed to
     28 find-file).
     29 
     30 This list will be traversed in order, so multiple matching
     31 regexps are possible.
     32 
     33 Example:
     34 
     35 Assuming you run emacs locally and connect to sly running on
     36 the machine 'soren' and you can connect with the username
     37 'animaliter':
     38 
     39   (push (list \"^soren$\"
     40               (lambda (emacs-filename)
     41                 (subseq emacs-filename (length \"/ssh:animaliter@soren:\")))
     42               (lambda (lisp-filename)
     43                 (concat \"/ssh:animaliter@soren:\" lisp-filename)))
     44         sly-filename-translations)
     45 
     46 See also `sly-create-filename-translator'."
     47   :type '(repeat (list :tag "Host description"
     48                        (regexp :tag "Hostname regexp")
     49                        (function :tag "To   lisp function")
     50                        (function :tag "From lisp function")))
     51   :group 'sly-lisp)
     52 
     53 (defun sly-find-filename-translators (hostname)
     54   (cond ((cdr (cl-assoc-if (lambda (regexp) (string-match regexp hostname))
     55                            sly-filename-translations)))
     56         (t (list #'identity #'identity))))
     57 
     58 (defun sly-make-tramp-file-name (username remote-host lisp-filename)
     59   "Tramp compatability function.
     60 
     61 Handles the signature of `tramp-make-tramp-file-name' changing
     62 over time."
     63   (cond
     64    ((>= emacs-major-version 26)
     65     ;; Emacs 26 requires the method to be provided and the signature of
     66     ;; `tramp-make-tramp-file-name' has changed.
     67     (tramp-make-tramp-file-name (tramp-find-method nil username remote-host)
     68                                 username
     69                                 nil
     70                                 remote-host
     71                                 nil
     72                                 lisp-filename))
     73    ((boundp 'tramp-multi-methods)
     74     (tramp-make-tramp-file-name nil nil
     75                                 username
     76                                 remote-host
     77                                 lisp-filename))
     78    (t
     79     (tramp-make-tramp-file-name nil
     80                                 username
     81                                 remote-host
     82                                 lisp-filename))))
     83 
     84 (cl-defun sly-create-filename-translator (&key machine-instance
     85                                                remote-host
     86                                                username)
     87   "Creates a three element list suitable for push'ing onto
     88 sly-filename-translations which uses Tramp to load files on
     89 hostname using username. MACHINE-INSTANCE is a required
     90 parameter, REMOTE-HOST defaults to MACHINE-INSTANCE and USERNAME
     91 defaults to (user-login-name).
     92 
     93 MACHINE-INSTANCE is the value returned by sly-machine-instance,
     94 which is just the value returned by cl:machine-instance on the
     95 remote lisp. REMOTE-HOST is the fully qualified domain name (or
     96 just the IP) of the remote machine. USERNAME is the username we
     97 should login with.
     98 The functions created here expect your tramp-default-method or
     99  tramp-default-method-alist to be setup correctly."
    100   (let ((remote-host (or remote-host machine-instance))
    101         (username (or username (user-login-name))))
    102     (list (concat "^" machine-instance "$")
    103           (lambda (emacs-filename)
    104             (tramp-file-name-localname
    105              (tramp-dissect-file-name emacs-filename)))
    106           `(lambda (lisp-filename)
    107              (sly-make-tramp-file-name
    108               ,username
    109               ,remote-host
    110               lisp-filename)))))
    111 
    112 (defun sly-tramp-to-lisp-filename (filename)
    113   (funcall (if (let ((conn (sly-current-connection)))
    114                  (and conn (process-live-p conn)))
    115                (cl-first (sly-find-filename-translators (sly-machine-instance)))
    116              'identity)
    117            (expand-file-name filename)))
    118 
    119 (defun sly-tramp-from-lisp-filename (filename)
    120   (funcall (cl-second (sly-find-filename-translators (sly-machine-instance)))
    121            filename))
    122 
    123 (provide 'sly-tramp)