Latest ffap.el source
Jared_Rhine@hmc.edu
Wed, 14 Dec 1994 13:28:33 -0500
I have received a number of request for the latest ffap sources, as the most
recent copy in the LCD appears to be out of date. The version I am
currently running is included below.
I have CCed this message to the author listed in the header so that he may
respond if there have been further updates to this package that I'm not
aware of.
For your convenience, this source is also available as:
/ftp.hmc.edu:/pub/emacs/packages/ffap/ffap.el.gz
I should note that there is one small modification I have made to
url-at-point so that it recognizes URLs prefixed with 'URL:'.
--cut here--
;; ffap.el: $Modified: Mon Dec 6 15:02:59 1993 by mic $
;; find-file-at-point, interactive replacement for find-file
;; By: Michelangelo Grigni <mic@cs.ucsd.edu>
;; This package defines find-file-at-point (and dired-dir-at-point).
;; Without a prefix, these behave just like find-file and dired. With
;; a prefix, they try to guess the default filename based on the text
;; around the point.
;;
;; If you have loaded the ange-ftp package, the function will also
;; fetch and recognize common variants of remote filenames.
;; Assuming you usually use this function to connect to anonymous-ftp
;; archives, you should either have a detailed .netrc file or have
;; (setq ange-ftp-default-user "anonymous") in your ~/.emacs file.
;;
;; If you have loaded (or autoloaded) the w3 package of William Perry,
;; (see cs.indiana.edu:/pub/elisp/w3/README), the function will also
;; recognize and fetch URL's.
;;
;; If you use the hyperbole package, you probably do not need this
;; package. On the other hand, this is much simpler.
;; Suggested .emacs contents:
;; (require 'ffap)
;; (global-set-key "\C-x\C-f" 'find-file-at-point)
;; (global-set-key "\C-xd" 'dired-dir-at-point)
;; Some test examples (try find-file-at-point in this text):
;; ~/.emacs, ffap.el, /usr/lib -- find local files
;; (load "ffap") -- try inside the quotes
;; (require 'ffap) -- similarly, in the symbol
;; #include <stdio.h> -- should work in c-mode, c++-mode
;; These need ange-ftp:
;; cs.ucsd.edu -- in this case, does a "ping"
;; cs.ucsd.edu:/pub -- in other cases, no "ping" is done
;; ftp.x.org:README -- a nice recursive example
;; ftp.x.org://README, /anonymous@ftp.x.org:/README -- synonyms
;; These URL's need w3:
;; ftp://ftp.x.org:/README -- another synonym
;; http://cs.indiana.edu:80/elisp/w3/docs.html
;; http://info.cern.ch:80/default.html
;; news:news.newusers.questions
;; Todo:
;; make machine-p and remote-filename-p more robust, or eliminate
;; comp.sources.unix/volume4/ -- go to an archive site?
;; ftp://site:/path -- bypass w3, convert to ange-ftp?
;; dired-dir-at-point is nearly useless, delete it?
;; if foo.bar.boz is not a file or machine, try as a newsgroup?
;; could first check news-path, second pass to nntp.el
;; handle <messageid>'s, using nntp.el
;; for info files, search Info-directory (or Info-directory-list)
;; History:
;; 3/29/93: first version: find-file-at-point, dired-dir-at-point,
;; file-name-at-point, file-name-remote-p, machine-p.
;; 4/13/93: modified to make guesses only with a prefix, not all the time.
;; 4/15/93: added "Pinging ..." message
;; 6/23/93: added primitive URL support, via w3 package
;; 12/3/93: translate bogus URL "site.dom://path/" to an ange-ftp path
;; 12/4/93: removed dependence on ange-ftp;
;; suggestions from pot@fly.CNUCE.CNR.IT (Francesco Potorti`):
;; eliminated non-standard save-match-data macro,
;; c-mode #include file support
;; 12/5/93: intruduced file-name-at-point-mode-alist variable, added
;; expand-load-file-name (from ange-load.el)
;; 12/6/93: extended comments
(defvar likely-machine-suffixes
;; A real crock! Do this to avoid pinging as much as possible ...
'("com" "edu" "us" "net" "org" "mil" "ca" "uk" "gov" "de"
"dk" "jp" "it" "au" "fi")
"List of common domain suffixes of internet machine names, lower case.
Used by file-name-at-point to avoid testing filenames with machine-p.")
(defvar ffap-url-regexp
;; I assume here that all URL's except "news:group" require a site:
"\\`\\(news:\\|\\(ftp\\|http\\|file\\|telnet\\|gopher\\)://\\)"
"Regexp matching common URL's. See the w3 package for details.")
(defun machine-p (host &optional service)
"Tests whether HOST exists, using open-network-stream.
Optional SERVICE specifies service or port \(default is \"discard\"\).
A returned string indicates the host exists but is not responding."
;; Probably there is a more efficient definition for this function,
;; like (fset machine-p 'stringp).
;; (machine-p "cs") --> t
;; (machine-p "cs" 5678) --> "Host \"cs\" not responding"
;; (machine-p "foo") --> nil
(condition-case error
(progn
(delete-process
(open-network-stream "machine-p" nil host (or service "discard")))
t)
(error
(let ((mesg (car (cdr error))))
(cond
((string-equal (substring mesg 0 12) "Unknown host") nil)
((string-equal (substring mesg -14) "not responding") mesg)
;; Could be "Unknown service":
(t (signal (car error) (cdr error))))))))
(defun file-name-remote-p (filename)
"Test whether FILENAME looks like a remote filename."
(or (and (featurep 'ange-ftp)
(string-match "\\`/[^:/@.]+[@.][^:/]+:" filename))
(string-match "\\`/afs/." filename)))
(defun find-file-at-point (filename)
"Like find-file. With prefix, guess FILENAME (or URL) from buffer.
See file-name-at-point, url-at-point, dired-dir-at-point."
(interactive
(list
(let (guess dir name)
(if (setq guess (and current-prefix-arg (url-at-point)))
(read-string "Fetch URL (or file): " guess)
(if (setq guess (and current-prefix-arg (file-name-at-point)))
(progn
(setq dir (file-name-directory guess)
name (file-name-nondirectory guess))
(if (equal dir "") (setq dir nil))
(if (equal name "") (setq name nil))))
(read-file-name
(if name (format "Find file (%s): " name) "Find file: ")
dir guess)))))
(if (string-match ffap-url-regexp filename)
(w3-fetch filename)
(switch-to-buffer (find-file-noselect filename))))
(defun dired-dir-at-point (dirname)
;; This assumes tree dired, not the standard 18.5* dired.
;; BUG: if point is in "dir/file", where dir/file does not
;; exist but dir/ does, this will fail to guess "dir/".
"Like dired. With a prefix, guesses DIRNAME from buffer contents
around point. See also file-name-at-point, find-file-at-point.
NOTE: unlike the tree dired function, there is no way to set
the ls switches interactively."
(interactive
(let ((guess (and current-prefix-arg (file-name-at-point)))
(default-directory default-directory))
(and guess
(not (string-match "/$" guess))
(file-directory-p guess)
(setq guess (concat guess "/")))
(if guess (setq guess (file-name-directory guess)))
(if guess (setq default-directory guess))
(list
(read-file-name "Dired (directory): " nil default-directory nil)
)))
;; This could be old dired or tree dired:
(switch-to-buffer (dired-noselect dirname)))
(defun string-at-point (chars &optional begpunct endpunct)
"Return maximal string around point, of chars specified by string CHARS.
Chars from the optional BEGPUNCT string are stripped from the beginning,
Chars from the optional ENDPUNCT string are stripped from the end."
(let ((pt (point)))
(buffer-substring
(save-excursion
(skip-chars-backward chars)
(and begpunct (skip-chars-forward begpunct pt))
(point))
(save-excursion
(skip-chars-forward chars)
(and endpunct (skip-chars-backward endpunct pt))
(point)))))
; This function has been modified by Jared Rhine to work correctly on a URL
; which is prefaced with 'URL:'.
(defun url-at-point nil
"Return URL from around point if it exists, or nil."
(and (fboundp 'w3-fetch) ;; could be just an autoload now ...
(let* ((case-fold-search t)
; (name (string-at-point "--:$+@-Z_a-z~#" nil ";.,!?"))
(name (string-at-point "--:$+@-Z_a-z~#" "URL:" ";.,!?"))
(data (match-data)))
(unwind-protect
(and (string-match ffap-url-regexp name) name)
(store-match-data data)))))
(defvar file-name-at-point-mode-alist
(list
'(emacs-lisp-mode .
(lambda (name) (expand-load-file-name name '(".el" ""))))
(cons 'c-mode
(defun c-mode-ffap (name)
(expand-file-name name "/usr/include")))
'(c++-mode . c-mode-ffap)
)
"\
Alist of (mode . function). If file-name-at-point has a string NAME
which is not an existing filename, and if the current major-mode is
listed, then (function NAME) should be another filename to try.")
(defun expand-load-file-name (file &optional nosuffix path) "\
A generic path-searching function, defaults to mimic load behavior.
Returns path of an existing file that (load FILE) would load, or nil.
Optional second argument NOSUFFIX, if t, is like the fourth argument
for load, i.e. don't try adding suffixes \".elc\" and \".el\".
If NOSUFFIX is a list, it is taken as a list of suffixes to try.
Optional third argument PATH specifies a different search path, it
defaults to load-path."
(or path (setq path load-path))
(if (file-name-absolute-p file)
(setq path (list (file-name-directory file))
file (file-name-nondirectory file)))
(let ((suffixes-to-try
(cond
((consp nosuffix) nosuffix)
(nosuffix '(""))
(t '(".elc" ".el" "")))))
(let (found suffixes)
(while (and path (not found))
(setq suffixes suffixes-to-try)
(while (and suffixes (not found))
(let ((try (expand-file-name
(concat file (car suffixes))
(car path))))
(if (and (file-exists-p try) (not (file-directory-p try)))
(setq found try)))
(setq suffixes (cdr suffixes)))
(setq path (cdr path)))
found)))
(defun file-name-at-point nil
"Return filename from around point if it exists, or nil.
Existence test is skipped for names that look like ange-ftp paths."
;; Note: this function does not need to check for URL's, just
;; filenames. On the other hand, it is responsible for converting
;; the a pseudo-URL like "site.dom://path" to an ange-ftp style path
;; "/site.dom:/path"
(let* ((case-fold-search t)
(name (string-at-point "--:$+<>@-Z_a-z~" "<" ">;.,!?"))
;; Note: "<" and ">" punctuation for C modes
(data (match-data)))
(unwind-protect
(cond
((zerop (length name)) nil)
;; Accept ange-ftp paths without further existence checking:
((and (featurep 'ange-ftp)
(string-match "\\`/?\\([^/:.]+.[^:/@]+://\\)" name))
(concat "/"
(substring name (match-beginning 1) (1- (match-end 1)))
(substring name (match-end 1))))
;; Accept any other 'remote' names without further checking:
((if (eq (aref name 0) ?/)
(and (file-name-remote-p name) name)
(and (file-name-remote-p (concat "/" name)) (concat "/" name))))
((file-exists-p name) name)
;; Special cases for various modes, using the alist:
((let* ((f (assoc major-mode file-name-at-point-mode-alist))
(try (and f (funcall (cdr f) name))))
(and (stringp try) (file-exists-p try) try)))
;; Unadorned "user@site.dom" or "site.dom" may be a machine,
;; if "dom" is a known domain, try pinging the machine:
((and
(featurep 'ange-ftp)
(string-match "^\\([^:/@.]+@\\)?\\([^:/@]+\\)\\.\\([^:/@.]+\\)$"
name)
(member (downcase
(substring name (match-beginning 3) (match-end 3)))
likely-machine-suffixes)
(let ((machine (substring name (match-beginning 2) (match-end 3))))
(message "Pinging %s ..." machine) ; not really 'ping'
(machine-p machine)))
(concat "/" name ":")))
(store-match-data data))))
(provide 'ffap)
;; eof ffap.el
--cut here--
--
Jared_Rhine@hmc.edu | Harvey Mudd College | http://www.hmc.edu/~jared/home.html
"Sometimes you're the windshield; sometimes you're the bug."
-- Dire Straits