[slime-devel] find-file-at-point on logical pathnames - slime-devel - mailman3.common-lisp.net

16 Nov 2004


      I have a hack on ffap that I did just now. Needs more testing, but its 
so simple and so convenient that I Have to share it right away. Stick 
this in your .emacs file if you want to evaluate it. First, I customize 
the ffap-string-at-point variable and create a helper function. Then a 
doctored version of ffap-file-at-point.
--- elisp code follows ---
;; File name constituents for lisp-mode
;; the string constituents could probably use some adjustment
(setq ffap-string-at-point-mode-alist
    (cons '(lisp-mode "--:;$+<>@-Z_a-z~" "" "") 
ffap-string-at-point-mode-alist ))
(defun ffap-slime-file (name)
  "Return unix version of lisp file NAME if slime
is running and we are in a lisp buffer, and unix-file
exists.  Else return nil"
  (and
   (eql major-mode 'lisp-mode)
   (fboundp 'slime-connected-p)
   (slime-connected-p)
   (slime-eval `(cl:ignore-errors
                 (cl:or
                   (cl:and
                    (cl:probe-file ,name) (ext:unix-namestring ,name))
                   (cl:and
                    (cl:probe-file (cl:concatenate 'cl:string ,name 
".lisp"))
                    (ext:unix-namestring (cl:concatenate 'cl:string 
,name ".lisp"))))))))
;; The following hacked version of ffap-file-at-point has ONE line 
changed, see comment
;; at the line
(defun ffap-file-at-point nil
  "Return filename from around point if it exists, or nil.
Existence test is skipped for names that look remote.
If the filename is not obvious, it also tries `ffap-alist',
which may actually result in an url rather than a filename."
  ;; Note: this function does not need to look for url's, just
  ;; filenames.  On the other hand, it is responsible for converting
  ;; a pseudo-url "site.com://path" to an ftp path
  (let* ((case-fold-search t)        ; url prefixes are case-insensitive
     (data (match-data))
     (string (ffap-string-at-point)) ; uses mode alist
     (name
      (or (condition-case nil
          (and (not (string-match "//" string)) ; foo.com://bar
               (substitute-in-file-name string))
        (error nil))
          string))
     (abs (file-name-absolute-p name))
     (default-directory default-directory))
    (unwind-protect
    (cond
     ;; Immediate rejects (/ and // are too common in C++):
((member name '("" "/" "//" ".")) nil)
         ((and (not abs) (ffap-slime-file name)))    ;; This line is NEW 
NEW NEW
         ;; Immediately test local filenames.  If default-directory is
         ;; remote, you probably already have a connection.
         ((and (not abs) (ffap-file-exists-string name)))
         ;; Try stripping off line numbers; good for compilation/grep 
output.
         ((and (not abs) (string-match ":[0-9]" name)
               (ffap-file-exists-string (substring name 0 
(match-beginning 0)))))
     ;; Immediately test local filenames.  If default-directory is
     ;; remote, you probably already have a connection.
     ((and (not abs) (ffap-file-exists-string name)))
     ;; Accept remote names without actual checking (too slow):
     ((if abs
          (ffap-file-remote-p name)
        ;; Try adding a leading "/" (common omission in ftp paths):
        (and
         ffap-ftp-sans-slash-regexp
         (string-match ffap-ftp-sans-slash-regexp name)
         (ffap-file-remote-p (concat "/" name)))))
     ;; Ok, not remote, try the existence test even if it is absolute:
     ((and abs (ffap-file-exists-string name)))
     ;; If it contains a colon, get rid of it (and return if exists)
     ((and (string-match path-separator name)
           (setq name (ffap-string-at-point 'nocolon))
           (ffap-file-exists-string name)))
     ;; File does not exist, try the alist:
     ((let ((alist ffap-alist) tem try case-fold-search)
        (while (and alist (not try))
          (setq tem (car alist) alist (cdr alist))
          (if (or (eq major-mode (car tem))
              (and (stringp (car tem))
               (string-match (car tem) name)))
          (and (setq try
                 (condition-case nil
                 (funcall (cdr tem) name)
                   (error nil)))
               (setq try (or
                  (ffap-url-p try) ; not a file!
                  (ffap-file-remote-p try)
                  (ffap-file-exists-string try))))))
        try))
     ;; Alist failed?  Try to guess an active remote connection
     ;; from buffer variables, and try once more, both as an
     ;; absolute and relative path on that remote host.
     ((let* (ffap-rfs-regexp    ; suppress
         (remote-dir
          (cond
           ((ffap-file-remote-p default-directory))
           ((and (eq major-mode 'internal-ange-ftp-mode)
             (string-match "^\*ftp \(.*\)@\(.*\)\*$"
                       (buffer-name)))
            (concat "/" (substring (buffer-name) 5 -1) ":"))
           ;; This is too often a bad idea:
           ;;((and (eq major-mode 'w3-mode)
           ;;       (stringp url-current-server))
           ;; (host-to-ange-path url-current-server))
           )))
        (and remote-dir
         (or
          (and (string-match "\`\(/?~?ftp\)/" name)
               (ffap-file-exists-string
            (ffap-replace-path-component
             remote-dir (substring name (match-end 1)))))
          (ffap-file-exists-string
           (ffap-replace-path-component remote-dir name))))))
     )
      (set-match-data data))))
--- elisp code ends ---
The one point agains doing something like this is response time. If 
something like this is desired, I'll see about maybe doing it a bit more 
elegantly with an around method, althoug I don't quite see how to do 
that without worsening the response time even further. Would a custom 
function on the lisp side help speed things up?