1 ;;; ffap.el --- find file (or url) at point
3 ;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
5 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
6 ;; Created: 29 Mar 1993
7 ;; Keywords: files, hypermedia, matching, mouse
8 ;; X-URL: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
30 ;; Command find-file-at-point replaces find-file. With a prefix, it
31 ;; behaves exactly like find-file. Without a prefix, it first tries
32 ;; to guess a default file or URL from the text around the point
33 ;; (`ffap-require-prefix' swaps these behaviors). This is useful for
34 ;; following references in situations such as mail or news buffers,
35 ;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
38 ;; For the default installation, byte-compile ffap.el somewhere in
39 ;; your `load-path' and add these two lines to your .emacs file:
41 ;; (require 'ffap) ; load the package
42 ;; (ffap-bindings) ; do default key bindings
44 ;; ffap-bindings makes the following global key bindings:
46 ;; C-x C-f find-file-at-point (abbreviated as ffap)
47 ;; C-x 4 f ffap-other-window
48 ;; C-x 5 f ffap-other-frame
49 ;; S-mouse-3 ffap-at-mouse
50 ;; C-S-mouse-3 ffap-menu
52 ;; ffap-bindings also adds hooks to make the following local bindings
53 ;; in vm, gnus, and rmail:
55 ;; M-l ffap-next, or ffap-gnus-next in gnus (l == "link")
56 ;; M-m ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
58 ;; If you do not like these bindings, modify the variable
59 ;; `ffap-bindings', or write your own.
61 ;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
62 ;; to load or autoload them before ffap. If you use ff-paths, load it
63 ;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many
64 ;; option variables. In particular, if ffap is slow, try these:
66 ;; (setq ffap-alist nil) ; faster, dumber prompting
67 ;; (setq ffap-machine-p-known 'accept) ; no pinging
68 ;; (setq ffap-url-regexp nil) ; disable URL features in ffap
70 ;; ffap uses w3 (if found) or else browse-url to fetch URL's. For
71 ;; a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
72 ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
73 ;; the file and URL references within a buffer.
78 ;; The History and Contributors moved to ffap.LOG (same ftp site),
79 ;; which also has some old examples and commentary from ffap 1.5.
84 ;; * let "/path/file#key" jump to key (tag or regexp) in /path/file
85 ;; * find file of symbol if TAGS is loaded (like above)
86 ;; * break long menus into multiple panes (like imenu?)
87 ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
88 ;; * notice "machine.dom blah blah blah path/file" (how?)
89 ;; * as w3 becomes standard, rewrite to rely more on its functions
90 ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
91 ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
92 ;; * handle "$(VAR)" in Makefiles
93 ;; * use the font-lock machinery
100 ;; The code is organized in pages, separated by formfeed characters.
101 ;; See the next two pages for standard customization ideas.
107 "Find file or URL at point."
111 (defun ffap-soft-value (name &optional default)
112 "Return value of symbol with NAME, if it is interned.
113 Otherwise return nil (or the optional DEFAULT value)."
114 ;; Bug: (ffap-soft-value "nil" 5) --> 5
115 (let ((sym (intern-soft name)))
116 (if (and sym (boundp sym)) (symbol-value sym) default)))
118 (defcustom ffap-ftp-regexp
119 ;; This used to test for ange-ftp or efs being present, but it should be
120 ;; harmless (and simpler) to give it this value unconditionally.
122 "*Paths matching this regexp are treated as remote ftp paths by ffap.
123 If nil, ffap neither recognizes nor generates such paths."
124 :type '(choice (const :tag "Disable" nil)
125 (const :tag "Standard" "\\`/[^/:]+:")
129 (defcustom ffap-url-unwrap-local t
130 "*If non-nil, convert \"file:\" url to local path before prompting."
134 (defcustom ffap-url-unwrap-remote t
135 "*If non-nil, convert \"ftp:\" url to remote path before prompting.
136 This is ignored if `ffap-ftp-regexp' is nil."
140 (defcustom ffap-ftp-default-user "anonymous"
141 "*User name in ftp paths generated by `ffap-host-to-path'.
142 Note this name may be omitted if it equals the default
143 \(either `efs-default-user' or `ange-ftp-default-user'\)."
147 (defcustom ffap-rfs-regexp
148 ;; Remote file access built into file system? HP rfa or Andrew afs:
149 "\\`/\\(afs\\|net\\)/."
150 ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
151 "*Matching paths are treated as remote. nil to disable."
155 (defvar ffap-url-regexp
156 ;; Could just use `url-nonrelative-link' of w3, if loaded.
157 ;; This regexp is not exhaustive, it just matches common cases.
160 "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
162 "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
163 "\\)." ; require one more character
165 "Regexp matching URL's. nil to disable URL features in ffap.")
167 (defcustom ffap-foo-at-bar-prefix "mailto"
168 "*Presumed URL prefix type of strings like \"<foo.9z@bar>\".
169 Sensible values are nil, \"news\", or \"mailto\"."
170 :type '(choice (const "mailto")
172 (const :tag "Disable" nil)
173 ;; string -- possible, but not really useful
178 ;;; Peanut Gallery (More User Variables):
180 ;; Users of ffap occasionally suggest new features. If I consider
181 ;; those features interesting but not clear winners (a matter of
182 ;; personal taste) I try to leave options to enable them. Read
183 ;; through this section for features that you like, put an appropriate
184 ;; enabler in your .emacs file.
186 (defcustom ffap-dired-wildcards nil
187 ;; Suggestion from RHOGEE, 07 Jul 1994. Disabled, dired is still
188 ;; available by "C-x C-d <pattern>", and valid filenames may
189 ;; sometimes contain wildcard characters.
190 "*A regexp matching filename wildcard characters, or nil.
191 If `find-file-at-point' gets a filename matching this pattern,
192 it passes it on to `dired' instead of `find-file'."
193 :type '(choice (const :tag "Disable" nil)
194 (const :tag "Enable" "[*?][^/]*\\'")
195 ;; regexp -- probably not useful
199 (defcustom ffap-newfile-prompt nil
200 ;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is
201 ;; better handled by `find-file-not-found-hooks'.
202 "*Whether `find-file-at-point' prompts about a nonexistent file."
206 (defcustom ffap-require-prefix nil
207 ;; Suggestion from RHOGEE, 20 Oct 1994.
208 "*If set, reverses the prefix argument to `find-file-at-point'.
209 This is nil so neophytes notice ffap. Experts may prefer to disable
210 ffap most of the time."
214 (defcustom ffap-file-finder 'find-file
215 "*The command called by `find-file-at-point' to find a file."
218 (put 'ffap-file-finder 'risky-local-variable t)
220 (defcustom ffap-url-fetcher
221 (cond ((fboundp 'w3-fetch) 'w3-fetch)
222 ((fboundp 'browse-url-netscape) 'browse-url-netscape)
224 ;; Remote control references:
225 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
226 ;; http://home.netscape.com/newsref/std/x-remote.html
227 "*A function of one argument, called by ffap to fetch an URL.
228 Reasonable choices are `w3-fetch' or `browse-url-netscape'.
229 For a fancier alternative, get ffap-url.el."
230 :type '(choice (const w3-fetch)
231 (const browse-url-netscape)
232 (const browse-url-mosaic)
235 (put 'ffap-url-fetcher 'risky-local-variable t)
238 ;;; Compatibility (XEmacs code suppressed in this version):
241 (defalias 'ffap-make-overlay 'make-overlay)
242 (defalias 'ffap-delete-overlay 'delete-overlay) ; reusable
243 (defalias 'ffap-move-overlay 'move-overlay)
244 (defalias 'ffap-overlay-put 'overlay-put) ; 'face
245 (defalias 'ffap-find-face 'internal-find-face)
246 (defun ffap-mouse-event nil ; current mouse event, or nil
247 (and (listp last-nonmenu-event) last-nonmenu-event))
248 (defun ffap-event-buffer (event) (window-buffer (car (event-start event))))
252 ;;; Find Next Thing in buffer (`ffap-next'):
254 ;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
255 ;; then, broke it up into ffap-next-guess (noninteractive) and
256 ;; ffap-next (a command). It now work on files as well as url's.
258 (defcustom ffap-next-regexp
259 ;; If you want ffap-next to find URL's only, try this:
260 ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
261 ;; (concat "\\<" (substring ffap-url-regexp 2))))
263 ;; It pays to put a big fancy regexp here, since ffap-guesser is
264 ;; much more time-consuming than regexp searching:
265 "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
266 "*Regular expression governing movements of `ffap-next'."
270 (defvar ffap-next-guess nil
271 "Last value returned by `ffap-next-guess'.")
273 (defvar ffap-string-at-point-region '(1 1)
274 "List (BEG END), last region returned by `ffap-string-at-point'.")
276 (defun ffap-next-guess (&optional back lim)
277 "Move point to next file or URL, and return it as a string.
278 If nothing is found, leave point at limit and return nil.
279 Optional BACK argument makes search backwards.
280 Optional LIM argument limits the search.
281 Only considers strings that match `ffap-next-regexp'."
282 (or lim (setq lim (if back (point-min) (point-max))))
284 (while (not (or guess (eq (point) lim)))
285 (funcall (if back 're-search-backward 're-search-forward)
286 ffap-next-regexp lim 'move)
287 (setq guess (ffap-guesser)))
288 ;; Go to end, so we do not get same guess twice:
289 (goto-char (nth (if back 0 1) ffap-string-at-point-region))
290 (setq ffap-next-guess guess)))
293 (defun ffap-next (&optional back wrap)
294 "Search buffer for next file or URL, and run ffap.
295 Optional argument BACK says to search backwards.
296 Optional argument WRAP says to try wrapping around if necessary.
297 Interactively: use a single prefix to search backwards,
298 double prefix to wrap forward, triple to wrap backwards.
299 Actual search is done by `ffap-next-guess'."
301 (cdr (assq (prefix-numeric-value current-prefix-arg)
302 '((1) (4 t) (16 nil t) (64 t t)))))
304 (guess (ffap-next-guess back)))
305 ;; Try wraparound if necessary:
306 (and (not guess) wrap
307 (goto-char (if back (point-max) (point-min)))
308 (setq guess (ffap-next-guess back pt)))
311 (sit-for 0) ; display point movement
312 (find-file-at-point (ffap-prompter guess)))
313 (goto-char pt) ; restore point
314 (message "No %sfiles or URL's found"
315 (if wrap "" "more ")))))
317 (defun ffap-next-url (&optional back wrap)
318 "Like `ffap-next', but search with `ffap-url-regexp'."
320 (let ((ffap-next-regexp ffap-url-regexp))
322 (call-interactively 'ffap-next)
323 (ffap-next back wrap))))
326 ;;; Machines (`ffap-machine-p'):
328 ;; I cannot decide a "best" strategy here, so these are variables. In
329 ;; particular, if `Pinging...' is broken or takes too long on your
330 ;; machine, try setting these all to accept or reject.
331 (defcustom ffap-machine-p-local 'reject ; this happens often
332 "*A symbol, one of: `ping', `accept', `reject'.
333 What `ffap-machine-p' does with hostnames that have no domain."
334 :type '(choice (const ping)
338 (defcustom ffap-machine-p-known 'ping ; 'accept for speed
339 "*A symbol, one of: ping, accept, reject.
340 What `ffap-machine-p' does with hostnames that have a known domain
341 \(see mail-extr.el for the known domains\)."
342 :type '(choice (const ping)
346 (defcustom ffap-machine-p-unknown 'reject
347 "*A symbol, one of: ping, accept, reject.
348 What `ffap-machine-p' does with hostnames that have an unknown domain
349 \(see mail-extr.el for the known domains\)."
350 :type '(choice (const ping)
355 (defun ffap-what-domain (domain)
356 ;; Like what-domain in mail-extr.el, returns string or nil.
358 (get (intern-soft (downcase domain) mail-extr-all-top-level-domains)
361 (defun ffap-machine-p (host &optional service quiet strategy)
362 "Decide whether HOST is the name of a real, reachable machine.
363 Depending on the domain (none, known, or unknown), follow the strategy
364 named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
365 or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
366 Optional SERVICE specifies the port used \(default \"discard\"\).
367 Optional QUIET flag suppresses the \"Pinging...\" message.
368 Optional STRATEGY overrides the three variables above.
370 t means that HOST answered.
371 'accept means the relevant variable told us to accept.
372 \"mesg\" means HOST exists, but does not respond for some reason."
373 ;; Try some (Emory local):
374 ;; (ffap-machine-p "ftp" nil nil 'ping)
375 ;; (ffap-machine-p "nonesuch" nil nil 'ping)
376 ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
377 ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
378 ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
379 ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
380 (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
381 (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
384 (and (string-match "\\.[^.]*$" host)
385 (downcase (substring host (1+ (match-beginning 0))))))
386 (what-domain (if domain (ffap-what-domain domain) "Local")))
389 (cond ((not domain) ffap-machine-p-local)
390 ((not what-domain) ffap-machine-p-unknown)
391 (t ffap-machine-p-known))))
393 ((eq strategy 'accept) 'accept)
394 ((eq strategy 'reject) nil)
395 ;; assume (eq strategy 'ping)
398 (if (stringp what-domain)
399 (message "Pinging %s (%s)..." host what-domain)
400 (message "Pinging %s ..." host)))
401 (condition-case error
405 "ffap-machine-p" nil host (or service "discard")))
408 (let ((mesg (car (cdr error))))
411 ((string-match "^Unknown host" mesg) nil)
412 ((string-match "not responding$" mesg) mesg)
414 ;; (file-error "connection failed" "permission denied"
415 ;; "nonesuch" "ffap-machine-p")
416 ;; (file-error "connection failed" "host is unreachable"
417 ;; "gopher.house.gov" "ffap-machine-p")
418 ;; (file-error "connection failed" "address already in use"
419 ;; "ftp.uu.net" "ffap-machine-p")
420 ((equal mesg "connection failed")
421 (if (equal (nth 2 error) "permission denied")
422 nil ; host does not exist
423 ;; Other errors mean the host exists:
425 ;; Could be "Unknown service":
426 (t (signal (car error) (cdr error))))))))))))
429 ;;; Possibly Remote Resources:
431 (defun ffap-replace-path-component (fullname name)
432 "In remote FULLNAME, replace path with NAME. May return nil."
433 ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
436 (function (lambda (sym) (and (fboundp sym) (setq found sym))))
438 efs-replace-path-component
439 ange-ftp-replace-path-component
440 ange-ftp-replace-name-component
443 (fset 'ffap-replace-path-component found)
444 (funcall found fullname name))))
445 ;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")
447 (defun ffap-file-exists-string (file)
448 ;; With certain packages (ange-ftp, jka-compr?) file-exists-p
449 ;; sometimes returns a nicer string than it is given. Otherwise, it
450 ;; just returns nil or t.
451 "Return FILE \(maybe modified\) if it exists, else nil."
452 (and file ; quietly reject nil
453 (let ((exists (file-exists-p file)))
454 (and exists (if (stringp exists) exists file)))))
457 (defun ffap-file-remote-p (filename)
458 "If FILENAME looks remote, return it \(maybe slightly improved\)."
459 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
460 ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")
461 ;; (ffap-file-remote-p "/ffap.el:80")
462 (or (and ffap-ftp-regexp
463 (string-match ffap-ftp-regexp filename)
464 ;; Convert "/host.com://path" to "/host:/path", to handle a dieing
465 ;; practice of advertising ftp paths as "host.dom://path".
466 (if (string-match "//" filename)
467 ;; (replace-match "/" nil nil filename)
468 (concat (substring filename 0 (1+ (match-beginning 0)))
469 (substring filename (match-end 0)))
472 (string-match ffap-rfs-regexp filename)
475 (defun ffap-machine-at-point nil
476 "Return machine name at point if it exists, or nil."
477 (let ((mach (ffap-string-at-point 'machine)))
478 (and (ffap-machine-p mach) mach)))
480 (defsubst ffap-host-to-path (host)
481 "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
482 Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
483 (if (equal host "localhost")
485 (let ((user ffap-ftp-default-user))
486 ;; Avoid including the user if it is same as default:
487 (if (or (equal user (ffap-soft-value "ange-ftp-default-user"))
488 (equal user (ffap-soft-value "efs-default-user")))
490 (concat "/" user (and user "@") host ":"))))
492 (defun ffap-fixup-machine (mach)
493 ;; Convert a hostname into an url, an ftp path, or nil.
495 ((not (and ffap-url-regexp (stringp mach))) nil)
497 ((string-match "\\`gopher[-.]" mach) ; or "info"?
498 (concat "gopher://" mach "/"))
500 ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
501 (concat "http://" mach "/"))
502 ;; More cases? Maybe "telnet:" for archie?
503 (ffap-ftp-regexp (ffap-host-to-path mach))
506 (defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
507 "Strings not matching this fail `ffap-newsgroup-p'.")
508 (defvar ffap-newsgroup-heads ; entirely inadequate
509 '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
510 "Used by `ffap-newsgroup-p' if gnus is not running.")
512 (defun ffap-newsgroup-p (string)
513 "Return STRING if it looks like a newsgroup name, else nil."
515 (string-match ffap-newsgroup-regexp string)
516 (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb))
517 (heads ffap-newsgroup-heads)
520 (setq htb (car htbs) htbs (cdr htbs))
523 ;; errs: htb symbol may be unbound, or not a hash-table.
524 ;; gnus-gethash is just a macro for intern-soft.
525 (and (intern-soft string (symbol-value htb))
526 (setq ret string htbs nil))
527 ;; If we made it this far, gnus is running, so ignore "heads":
531 (let ((head (string-match "\\`\\([a-z]+\\)\\." string)))
532 (and head (setq head (substring string 0 (match-end 1)))
535 ;; Is there ever a need to modify string as a newsgroup name?
538 (defsubst ffap-url-p (string)
539 "If STRING looks like an url, return it (maybe improved), else nil."
540 (let ((case-fold-search t))
541 (and ffap-url-regexp (string-match ffap-url-regexp string)
542 ;; I lied, no improvement:
545 ;; Broke these out of ffap-fixup-url, for use of ffap-url package.
546 (defsubst ffap-url-unwrap-local (url)
547 "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
548 (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
549 (substring url (1+ (match-end 1)))))
550 (defsubst ffap-url-unwrap-remote (url)
551 "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
552 (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
554 (ffap-host-to-path (substring url (match-beginning 2) (match-end 2)))
555 (substring url (match-beginning 3) (match-end 3)))))
556 ;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
558 (defun ffap-fixup-url (url)
559 "Clean up URL and return it, maybe as a file name."
561 ((not (stringp url)) nil)
562 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
563 ((and ffap-url-unwrap-remote ffap-ftp-regexp
564 (ffap-url-unwrap-remote url)))
565 ;; This might autoload the url package, oh well:
566 (t (let ((normal (and (fboundp 'url-normalize-url)
567 (url-normalize-url url))))
568 ;; In case url-normalize-url is confused:
569 (or (and normal (not (zerop (length normal))) normal)
575 ;; The upcoming ffap-alist actions need various utilities to prepare
576 ;; and search paths of directories. Too many features here.
578 ;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
579 ;; (defun ffap-splice (func inlist)
580 ;; "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
581 ;; (let* ((head (cons 17 nil)) (last head))
583 ;; (setcdr last (funcall func (car inlist)))
584 ;; (setq last (ffap-last last) inlist (cdr inlist)))
587 (defun ffap-list-env (env &optional empty)
588 "Return a list of strings parsed from environment variable ENV.
589 Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
590 also is substituted for the first empty-string component, if there is one.
591 Uses `path-separator' to separate the path into substrings."
592 ;; We cannot use parse-colon-path (files.el), since it kills
593 ;; "//" entries using file-name-as-directory.
594 ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
595 ;; in ff-paths and bib-cite. The EMPTY arg may help mimic kpathsea.
596 (if (or empty (getenv env)) ; should return something
597 (let ((start 0) match dir ret)
598 (setq env (concat (getenv env) path-separator))
599 (while (setq match (string-match path-separator env start))
600 (setq dir (substring env start match) start (1+ match))
601 ;;(and (file-directory-p dir) (not (member dir ret)) ...)
602 (setq ret (cons dir ret)))
603 (setq ret (nreverse ret))
604 (and empty (setq match (member "" ret))
605 (progn ; allow string or list here
606 (setcdr match (append (cdr-safe empty) (cdr match)))
607 (setcar match (or (car-safe empty) empty))))
610 (defun ffap-reduce-path (path)
611 "Remove duplicates and non-directories from PATH list."
614 (setq tem path path (cdr path))
615 (if (equal (car tem) ".") (setcar tem ""))
616 (or (member (car tem) ret)
617 (not (file-directory-p (car tem)))
618 (progn (setcdr tem ret) (setq ret tem))))
621 (defun ffap-all-subdirs (dir &optional depth)
622 "Return list all subdirectories under DIR, starting with itself.
623 Directories beginning with \".\" are ignored, and directory symlinks
624 are listed but never searched (to avoid loops).
625 Optional DEPTH limits search depth."
626 (and (file-exists-p dir)
627 (ffap-all-subdirs-loop (expand-file-name dir) (or depth -1))))
629 (defun ffap-all-subdirs-loop (dir depth) ; internal
630 (setq depth (1- depth))
632 (and (not (eq depth -1))
638 ((not (file-directory-p d)) nil)
639 ((file-symlink-p d) (list d))
640 (t (ffap-all-subdirs-loop d depth)))))
641 (directory-files dir t "\\`[^.]")
644 (defvar ffap-kpathsea-depth 1
645 "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
646 Set to 0 to avoid all searching, or nil for no limit.")
648 (defun ffap-kpathsea-expand-path (path)
649 "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs.
650 The subdirs begin with the original directory, and the depth of the
651 search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
652 kpathsea, a library used by some versions of TeX."
657 (if (string-match "[^/]//\\'" dir)
658 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
662 (defvar ffap-locate-jka-suffixes t
663 "List of compression suffixes tried by `ffap-locate-file'.
665 If not a list, it will be initialized by `ffap-locate-file', depending
666 on whether you use jka-compr (a.k.a. `auto-compression-mode').
667 Typical values are nil or '(\".gz\" \".Z\").") ; .z is dead
669 (defun ffap-locate-file (file &optional nosuffix path)
670 ;; Note the Emacs 20 version of locate-library could almost
671 ;; replace this function, except that it does not let us overrride
672 ;; the list of suffixes.
673 "A generic path-searching function, mimics `load' by default.
674 Returns path to file that \(load FILE\) would load, or nil.
675 Optional NOSUFFIX, if nil or t, is like the fourth argument
676 for load: whether to try the suffixes (\".elc\" \".el\" \"\").
677 If a nonempty list, it is a list of suffixes to try instead.
678 Optional PATH is a list of directories instead of `load-path'."
679 (or path (setq path load-path))
680 (if (file-name-absolute-p file)
681 (setq path (list (file-name-directory file))
682 file (file-name-nondirectory file)))
683 (let ((suffixes-to-try
685 ((consp nosuffix) nosuffix)
687 (t '(".elc" ".el" "")))))
688 ;; Note we no longer check for old versions of jka-compr, that
689 ;; would aggressively try to convert any foo to foo.gz.
690 (or (listp ffap-locate-jka-suffixes)
691 (setq ffap-locate-jka-suffixes
692 (and (rassq 'jka-compr-handler file-name-handler-alist)
693 '(".gz" ".Z")))) ; ".z" is dead, "" is implicit
694 (if ffap-locate-jka-suffixes ;
695 (setq suffixes-to-try
702 (function (lambda (x) (concat suf x)))
703 ffap-locate-jka-suffixes))))
705 (let (found suffixes)
706 (while (and path (not found))
707 (setq suffixes suffixes-to-try)
708 (while (and suffixes (not found))
709 (let ((try (expand-file-name
710 (concat file (car suffixes))
712 (if (and (file-exists-p try) (not (file-directory-p try)))
714 (setq suffixes (cdr suffixes)))
715 (setq path (cdr path)))
719 ;;; Action List (`ffap-alist'):
721 ;; These search actions depend on the major-mode or regexps matching
722 ;; the current name. The little functions and their variables are
723 ;; deferred to the next section, at some loss of "code locality". A
724 ;; good example of featuritis. Trim this list for speed.
728 ("" . ffap-completable) ; completion, slow on some systems
729 ("\\.info\\'" . ffap-info) ; gzip.info
730 ("\\`info/" . ffap-info-2) ; info/emacs
731 ("\\`[-a-z]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses]
732 ("\\.elc?\\'" . ffap-el) ; simple.el, simple.elc
733 (emacs-lisp-mode . ffap-el-mode) ; rmail, gnus, simple, custom
734 (finder-mode . ffap-el-mode) ; type {C-h p} and try it
735 (help-mode . ffap-el-mode) ; maybe useful
736 (c++-mode . ffap-c-mode) ; search ffap-c-path
737 (cc-mode . ffap-c-mode) ; same
738 ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h
739 (fortran-mode . ffap-fortran-mode) ; FORTRAN requested by MDB
740 ("\\.[fF]\\'" . ffap-fortran-mode)
741 (tex-mode . ffap-tex-mode) ; search ffap-tex-path
742 (latex-mode . ffap-latex-mode) ; similar
743 ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex)
744 ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path
745 ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile
746 ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z|
747 ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $
748 . ffap-rfc) ; "100% RFC2100 compliant"
749 (dired-mode . ffap-dired) ; maybe in a subdirectory
751 "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
752 If string NAME at point (maybe \"\") is not a file or url, these pairs
753 specify actions to try creating such a string. A pair matches if either
754 KEY is a symbol, and it equals `major-mode', or
755 KEY is a string, it should matches NAME as a regexp.
756 On a match, \(FUNCTION NAME\) is called and should return a file, an
757 url, or nil. If nil, search the alist for further matches.")
759 (put 'ffap-alist 'risky-local-variable t)
762 ;;; Action Definitions:
764 ;; Define various default members of `ffap-alist'.
766 (defun ffap-completable (name)
767 (let* ((dir (or (file-name-directory name) default-directory))
768 (cmp (file-name-completion (file-name-nondirectory name) dir)))
769 (and cmp (concat dir cmp))))
771 (defun ffap-home (name) (ffap-locate-file name t '("~")))
773 (defun ffap-info (name)
776 (or (ffap-soft-value "Info-directory-list")
777 (ffap-soft-value "Info-default-directory-list")
780 (defun ffap-info-2 (name) (ffap-info (substring name 5)))
782 (defun ffap-info-3 (name)
783 ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
784 (and (equal (ffap-string-around) "()") (ffap-info name)))
786 (defun ffap-el (name) (ffap-locate-file name t))
788 (defun ffap-el-mode (name)
789 ;; If name == "foo.el" we will skip it, since ffap-el already
790 ;; searched for it once. (This assumes the default ffap-alist.)
791 (and (not (string-match "\\.el\\'" name))
792 (ffap-locate-file name '(".el"))))
795 ;; Need smarter defaults here! Suggestions welcome.
796 '("/usr/include" "/usr/local/include"))
797 (defun ffap-c-mode (name)
798 (ffap-locate-file name t ffap-c-path))
800 (defvar ffap-fortran-path '("../include" "/usr/include"))
802 (defun ffap-fortran-mode (name)
803 (ffap-locate-file name t ffap-fortran-path))
805 (defvar ffap-tex-path
806 t ; delayed initialization
807 "Path where `ffap-tex-mode' looks for tex files.
808 If t, `ffap-tex-init' will initialize this when needed.")
810 (defun ffap-tex-init nil
811 ;; Compute ffap-tex-path if it is now t.
812 (and (eq t ffap-tex-path)
813 ;; this may be slow, so say something
814 (message "Initializing ffap-tex-path ...")
819 (ffap-kpathsea-expand-path
821 (ffap-list-env "TEXINPUTS")
822 ;; (ffap-list-env "BIBINPUTS")
824 "TeX-macro-global" ; AUCTeX
825 '("/usr/local/lib/tex/macros"
826 "/usr/local/lib/tex/inputs")))))))))
828 (defun ffap-tex-mode (name)
830 (ffap-locate-file name '(".tex" "") ffap-tex-path))
832 (defun ffap-latex-mode (name)
834 ;; only rare need for ""
835 (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
837 (defun ffap-tex (name)
839 (ffap-locate-file name t ffap-tex-path))
841 (defvar ffap-bib-path
842 (ffap-list-env "BIBINPUTS"
845 ;; a few wild guesses, need better
846 "/usr/local/lib/tex/macros/bib" ; Solaris?
847 "/usr/lib/texmf/bibtex/bib" ; Linux?
850 (defun ffap-bib (name)
851 (ffap-locate-file name t ffap-bib-path))
853 (defun ffap-dired (name)
854 (let ((pt (point)) dir try)
858 (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
859 (re-search-backward "^ *$" nil t)
860 (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t)
866 (match-beginning 1) (match-end 1)))))
869 ;; Maybe a "Lisp Code Directory" reference:
870 (defun ffap-lcd (name)
873 ;; lisp-dir-apropos output buffer:
874 (string-match "Lisp Code Dir" (buffer-name))
875 ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
876 ;; or maybe the holy LCD-Datafile itself:
877 (member (ffap-string-around) '("||" "|\n")))
879 ;; lispdir.el may not be loaded yet:
881 (ffap-soft-value "elisp-archive-host"
882 "archive.cis.ohio-state.edu"))
883 (file-name-as-directory
884 (ffap-soft-value "elisp-archive-directory"
885 "/pub/gnu/emacs/elisp-archive/"))
886 (substring name 2))))
888 (defvar ffap-rfc-path
889 (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt"))
891 (defun ffap-rfc (name)
892 (format ffap-rfc-path
893 (substring name (match-beginning 1) (match-end 1))))
896 ;;; At-Point Functions:
898 (defvar ffap-string-at-point-mode-alist
900 ;; The default, used when the `major-mode' is not found.
901 ;; Slightly controversial decisions:
902 ;; * strip trailing "@" and ":"
903 ;; * no commas (good for latex)
904 (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
905 ;; An url, or maybe a email/news message-id:
906 (url "--:=&?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
907 ;; Find a string that does *not* contain a colon:
908 (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
910 (machine "-a-zA-Z0-9." "" ".")
911 ;; Mathematica paths: allow backquotes
912 (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
914 "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
915 possibly a `major-mode' or some symbol internal to ffap
916 \(such as 'file, 'url, 'machine, and 'nocolon\).
917 `ffap-string-at-point' uses the data fields as follows:
918 1. find a maximal string of CHARS around point,
919 2. strip BEG chars before point from the beginning,
920 3. Strip END chars after point from the end.")
922 (defvar ffap-string-at-point nil
923 ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
924 "Last string returned by `ffap-string-at-point'.")
926 (defun ffap-string-at-point (&optional mode)
927 "Return a string of characters from around point.
928 MODE (defaults to `major-mode') is a symbol used to lookup string
929 syntax parameters in `ffap-string-at-point-mode-alist'.
930 If MODE is not found, we fall back on the symbol 'file.
931 Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
934 (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
935 (assq 'file ffap-string-at-point-mode-alist))))
940 (skip-chars-backward (car args))
941 (skip-chars-forward (nth 1 args) pt)
942 (setcar ffap-string-at-point-region (point)))
944 (skip-chars-forward (car args))
945 (skip-chars-backward (nth 2 args) pt)
946 (setcar (cdr ffap-string-at-point-region) (point))))))
947 (set-text-properties 0 (length str) nil str)
948 (setq ffap-string-at-point str)))
950 (defun ffap-string-around nil
951 ;; Sometimes useful to decide how to treat a string.
952 "Return string of two chars around last `ffap-string-at-point'.
953 Assumes the buffer has not changed."
957 (goto-char (car ffap-string-at-point-region))
958 (preceding-char)) ; maybe 0
960 (goto-char (nth 1 ffap-string-at-point-region))
961 (following-char)) ; maybe 0
964 (defun ffap-copy-string-as-kill (&optional mode)
965 ;; Requested by MCOOK. Useful?
966 "Call `ffap-string-at-point', and copy result to `kill-ring'."
968 (let ((str (ffap-string-at-point mode)))
970 (message "No string found around point.")
972 ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
973 (message "Copied to kill ring: %s" str))))
975 (defun ffap-url-at-point nil
976 "Return url from around point if it exists, or nil."
977 ;; Could use w3's url-get-url-at-point instead. Both handle "URL:",
978 ;; ignore non-relative links, trim punctuation. The other will
979 ;; actually look back if point is in whitespace, but I would rather
980 ;; ffap be less aggressive in such situations.
984 ;; In a w3 buffer button?
985 (and (eq major-mode 'w3-mode)
986 ;; interface recommended by wmperry:
987 (w3-view-this-url t))
988 ;; Is there a reason not to strip trailing colon?
989 (let ((name (ffap-string-at-point 'url)))
991 ((string-match "^url:" name) (setq name (substring name 4)))
992 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z0-9]\\'" name)
993 ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
994 ;; Without "<>" it must be "mailto". Otherwise could be
995 ;; either, so consult `ffap-foo-at-bar-prefix'.
996 (let ((prefix (if (and (equal (ffap-string-around) "<>")
997 ;; Expect some odd characters:
998 (string-match "[$.0-9].*[$.0-9].*@" name))
1000 ffap-foo-at-bar-prefix
1002 (and prefix (setq name (concat prefix ":" name))))))
1003 ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
1004 ((and (string-match "\\`[a-z0-9]+\\'" name) ; <mic> <root> <nobody>
1005 (equal (ffap-string-around) "<>")
1006 ;; (ffap-user-p name):
1007 (not (string-match "~" (expand-file-name (concat "~" name))))
1009 (setq name (concat "mailto:" name)))
1011 (and (ffap-url-p name) name)
1014 (defvar ffap-gopher-regexp
1015 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
1016 "Regexp Matching a line in a gopher bookmark (maybe indented).
1017 The two subexpressions are the KEY and VALUE.")
1019 (defun ffap-gopher-at-point nil
1020 "If point is inside a gopher bookmark block, return its url."
1021 ;; `gopher-parse-bookmark' from gopher.el is not so robust
1024 (if (looking-at ffap-gopher-regexp)
1026 (while (and (looking-at ffap-gopher-regexp) (not (bobp)))
1028 (or (looking-at ffap-gopher-regexp) (forward-line 1))
1029 (let ((type "1") name path host (port "70"))
1030 (while (looking-at ffap-gopher-regexp)
1033 (buffer-substring (match-beginning 1)
1035 (val (buffer-substring (match-beginning 2)
1039 (if (and path (string-match "^ftp:.*@" path))
1041 (substring path 4 (1- (match-end 0)))
1042 (substring path (match-end 0)))
1043 (and (= (length type) 1)
1044 host;; (ffap-machine-p host)
1045 (concat "gopher://" host
1046 (if (equal port "70") "" (concat ":" port))
1047 "/" type path))))))))
1049 (defvar ffap-ftp-sans-slash-regexp
1052 ;; Note: by now, we know it is not an url.
1053 ;; Icky regexp avoids: default: 123: foo::bar cs:pub
1054 ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
1055 "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
1056 "Strings matching this are coerced to ftp paths by ffap.
1057 That is, ffap just prepends \"/\". Set to nil to disable.")
1059 (defun ffap-file-at-point nil
1060 "Return filename from around point if it exists, or nil.
1061 Existence test is skipped for names that look remote.
1062 If the filename is not obvious, it also tries `ffap-alist',
1063 which may actually result in an url rather than a filename."
1064 ;; Note: this function does not need to look for url's, just
1065 ;; filenames. On the other hand, it is responsible for converting
1066 ;; a pseudo-url "site.com://path" to an ftp path
1067 (let* ((case-fold-search t) ; url prefixes are case-insensitive
1069 (string (ffap-string-at-point)) ; uses mode alist
1071 (or (condition-case nil
1072 (and (not (string-match "//" string)) ; foo.com://bar
1073 (substitute-in-file-name string))
1076 (abs (file-name-absolute-p name))
1077 (default-directory default-directory))
1080 ;; Immediate rejects (/ and // are too common in C++):
1081 ((member name '("" "/" "//")) nil)
1082 ;; Immediately test local filenames. If default-directory is
1083 ;; remote, you probably already have a connection.
1084 ((and (not abs) (ffap-file-exists-string name)))
1085 ;; Accept remote names without actual checking (too slow):
1087 (ffap-file-remote-p name)
1088 ;; Try adding a leading "/" (common omission in ftp paths):
1090 ffap-ftp-sans-slash-regexp
1091 (string-match ffap-ftp-sans-slash-regexp name)
1092 (ffap-file-remote-p (concat "/" name)))))
1093 ;; Ok, not remote, try the existence test even if it is absolute:
1094 ((and abs (ffap-file-exists-string name)))
1095 ;; If it contains a colon, get rid of it (and return if exists)
1096 ((and (string-match path-separator name)
1097 (setq name (ffap-string-at-point 'nocolon))
1098 (ffap-file-exists-string name)))
1099 ;; File does not exist, try the alist:
1100 ((let ((alist ffap-alist) tem try case-fold-search)
1101 (while (and alist (not try))
1102 (setq tem (car alist) alist (cdr alist))
1103 (if (or (eq major-mode (car tem))
1104 (and (stringp (car tem))
1105 (string-match (car tem) name)))
1108 (funcall (cdr tem) name)
1111 (ffap-url-p try) ; not a file!
1112 (ffap-file-remote-p try)
1113 (ffap-file-exists-string try))))))
1115 ;; Alist failed? Try to guess an active remote connection
1116 ;; from buffer variables, and try once more, both as an
1117 ;; absolute and relative path on that remote host.
1118 ((let* (ffap-rfs-regexp ; suppress
1121 ((ffap-file-remote-p default-directory))
1122 ((and (eq major-mode 'internal-ange-ftp-mode)
1123 (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$"
1125 (concat "/" (substring (buffer-name) 5 -1) ":"))
1126 ;; This is too often a bad idea:
1127 ;;((and (eq major-mode 'w3-mode)
1128 ;; (stringp url-current-server))
1129 ;; (host-to-ange-path url-current-server))
1133 (and (string-match "\\`\\(/?~?ftp\\)/" name)
1134 (ffap-file-exists-string
1135 (ffap-replace-path-component
1136 remote-dir (substring name (match-end 1)))))
1137 (ffap-file-exists-string
1138 (ffap-replace-path-component remote-dir name))))))
1140 (store-match-data data))))
1143 ;;; Prompting (`ffap-read-file-or-url'):
1145 ;; We want to complete filenames as in read-file-name, but also url's
1146 ;; which read-file-name-internal would truncate at the "//" string.
1147 ;; The solution here is to replace read-file-name-internal with
1148 ;; `ffap-read-file-or-url-internal', which checks the minibuffer
1149 ;; contents before attempting to complete filenames.
1151 (defun ffap-read-file-or-url (prompt guess)
1152 "Read file or url from minibuffer, with PROMPT and initial GUESS."
1153 (or guess (setq guess default-directory))
1155 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
1156 ;; or "w3/" or "../el/ffap.el" or "../../../"
1157 (or (ffap-url-p guess)
1159 (or (ffap-file-remote-p guess)
1160 (setq guess (abbreviate-file-name (expand-file-name guess))))
1161 (setq dir (file-name-directory guess))))
1165 'ffap-read-file-or-url-internal
1168 (if dir (cons guess (length dir)) guess)
1169 (list 'file-name-history)
1171 ;; Do file substitution like (interactive "F"), suggested by MCOOK.
1172 (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
1173 ;; Should not do it on url's, where $ is a common (VMS?) character.
1174 ;; Note: upcoming url.el package ought to handle this automatically.
1177 (defun ffap-read-url-internal (string dir action)
1178 "Complete url's from history, treating given string as valid."
1179 (let ((hist (ffap-soft-value "url-global-history-hash-table")))
1182 (or (try-completion string hist) string))
1184 (or (all-completions string hist) (list string)))
1185 ;; action == lambda, documented where? Tests whether string is a
1186 ;; valid "match". Let us always say yes.
1189 (defun ffap-read-file-or-url-internal (string dir action)
1190 (if (ffap-url-p string)
1191 (ffap-read-url-internal string dir action)
1192 (read-file-name-internal string dir action)))
1194 ;; The rest of this page is just to work with package complete.el.
1195 ;; This code assumes that you load ffap.el after complete.el.
1197 ;; We must inform complete about whether our completion function
1198 ;; will do filename style completion. For earlier versions of
1199 ;; complete.el, this requires a defadvice. For recent versions
1200 ;; there may be a special variable for this purpose.
1202 (defun ffap-complete-as-file-p nil
1203 ;; Will `minibuffer-completion-table' complete the minibuffer
1204 ;; contents as a filename? Assumes the minibuffer is current.
1205 ;; Note: t and non-nil mean somewhat different reasons.
1206 (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
1207 (not (ffap-url-p (buffer-string))) ; t
1208 (memq minibuffer-completion-table
1209 '(read-file-name-internal read-directory-name-internal)) ; list
1213 (featurep 'complete)
1214 (if (boundp 'PC-completion-as-file-name-predicate)
1215 ;; modern version of complete.el, just set the variable:
1216 (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)
1218 (defadvice PC-do-completion (around ffap-fix act)
1220 (let ((minibuffer-completion-table
1221 (if (eq t (ffap-complete-as-file-p))
1222 'read-file-name-internal
1223 minibuffer-completion-table)))
1227 ;;; Highlighting (`ffap-highlight'):
1229 ;; Based on overlay highlighting in Emacs 19.28 isearch.el.
1231 (defvar ffap-highlight (and window-system t)
1232 "If non-nil, ffap highlights the current buffer substring.")
1234 (defvar ffap-highlight-overlay nil
1235 "Overlay used by `ffap-highlight'.")
1237 (defun ffap-highlight (&optional remove)
1238 "If `ffap-highlight' is set, highlight the guess in this buffer.
1239 That is, the last buffer substring found by `ffap-string-at-point'.
1240 Optional argument REMOVE means to remove any such highlighting.
1241 Uses the face `ffap' if it is defined, or else `highlight'."
1244 (and ffap-highlight-overlay
1245 (ffap-delete-overlay ffap-highlight-overlay)))
1246 ((not ffap-highlight) nil)
1247 (ffap-highlight-overlay
1248 (ffap-move-overlay ffap-highlight-overlay
1249 (car ffap-string-at-point-region)
1250 (nth 1 ffap-string-at-point-region)
1253 (setq ffap-highlight-overlay
1254 (apply 'ffap-make-overlay ffap-string-at-point-region))
1255 (ffap-overlay-put ffap-highlight-overlay 'face
1256 (if (ffap-find-face 'ffap)
1257 'ffap 'highlight)))))
1260 ;;; The big cheese (`ffap'):
1262 (defun ffap-guesser nil
1263 "Return file or URL or nil, guessed from text around point."
1264 (or (and ffap-url-regexp
1265 (ffap-fixup-url (or (ffap-url-at-point)
1266 (ffap-gopher-at-point))))
1267 (ffap-file-at-point) ; may yield url!
1268 (ffap-fixup-machine (ffap-machine-at-point))))
1270 (defun ffap-prompter (&optional guess)
1271 ;; Does guess and prompt step for find-file-at-point.
1272 ;; Extra complication for the temporary highlighting.
1274 (ffap-read-file-or-url
1275 (if ffap-url-regexp "Find file or URL: " "Find file: ")
1277 (setq guess (or guess (ffap-guesser)))
1278 (and guess (ffap-highlight))
1280 (ffap-highlight t)))
1283 (defun find-file-at-point (&optional filename)
1284 "Find FILENAME, guessing a default from text around point.
1285 If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
1286 With a prefix, this command behaves exactly like `ffap-file-finder'.
1287 If `ffap-require-prefix' is set, the prefix meaning is reversed.
1288 See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
1289 and the functions `ffap-file-at-point' and `ffap-url-at-point'.
1291 See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
1293 (if (and (interactive-p)
1294 (if ffap-require-prefix (not current-prefix-arg)
1295 current-prefix-arg))
1296 ;; Do exactly the ffap-file-finder command, even the prompting:
1297 (let (current-prefix-arg) ; we already interpreted it
1298 (call-interactively ffap-file-finder))
1299 (or filename (setq filename (ffap-prompter)))
1301 ((ffap-url-p filename)
1302 (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC
1303 (funcall ffap-url-fetcher filename)))
1304 ;; This junk more properly belongs in a modified ffap-file-finder:
1305 ((and ffap-dired-wildcards
1306 (string-match ffap-dired-wildcards filename))
1308 ((or (not ffap-newfile-prompt)
1309 (file-exists-p filename)
1310 (y-or-n-p "File does not exist, create buffer? "))
1311 (funcall ffap-file-finder
1312 ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
1313 (expand-file-name filename)))
1314 ;; User does not want to find a non-existent file:
1315 ((signal 'file-error (list "Opening file buffer"
1316 "no such file or directory"
1319 ;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
1320 ;; The defun is for autoload.el; the defalias takes over at load time.
1322 (defun ffap (&optional filename)
1323 "A short alias for the find-file-at-point command.")
1324 (defalias 'ffap 'find-file-at-point)
1327 ;;; Menu support (`ffap-menu'):
1329 (defvar ffap-menu-regexp nil
1330 "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
1331 Make this more restrictive for faster menu building.
1332 For example, try \":/\" for URL (and some ftp) references.")
1334 (defvar ffap-menu-alist nil
1335 "Buffer local cache of menu presented by `ffap-menu'.")
1336 (make-variable-buffer-local 'ffap-menu-alist)
1338 (defvar ffap-menu-text-plist
1340 '(face bold mouse-face highlight) ; keymap <mousy-map>
1342 "Text properties applied to strings found by `ffap-menu-rescan'.
1343 These properties may be used to fontify the menu references.")
1346 (defun ffap-menu (&optional rescan)
1347 "Put up a menu of files and urls mentioned in this buffer.
1348 Then set mark, jump to choice, and try to fetch it. The menu is
1349 cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
1350 The optional RESCAN argument \(a prefix, interactively\) forces
1351 a rebuild. Searches with `ffap-menu-regexp'."
1353 ;; (require 'imenu) -- no longer used, but roughly emulated
1354 (if (or (not ffap-menu-alist) rescan
1355 ;; or if the first entry is wrong:
1356 (and ffap-menu-alist
1357 (let ((first (car ffap-menu-alist)))
1359 (goto-char (cdr first))
1360 (not (equal (car first) (ffap-guesser)))))))
1364 (if ffap-url-regexp "Find file or URL" "Find file")
1365 (cons (cons "*Rescan Buffer*" -1) ffap-menu-alist)
1368 (defun ffap-menu-cont (choice) ; continuation of ffap-menu
1369 (if (< (cdr choice) 0)
1370 (ffap-menu t) ; *Rescan*
1372 (goto-char (cdr choice))
1373 ;; Momentary highlight:
1376 (and ffap-highlight (ffap-guesser) (ffap-highlight))
1377 (sit-for 0) ; display
1378 (find-file-at-point (car choice)))
1379 (ffap-highlight t))))
1381 (defun ffap-menu-ask (title alist cont)
1382 "Prompt from a menu of choices, and then apply some action.
1383 Arguments are TITLE, ALIST, and CONT \(a continuation function\).
1384 This uses either a menu or the minibuffer depending on invocation.
1385 The TITLE string is used as either the prompt or menu title.
1386 Each \(string . data\) ALIST entry defines a choice.
1387 Function CONT is applied to the entry chosen by the user."
1388 ;; Note: this function is used with a different continuation
1389 ;; by the ffap-url add-on package.
1390 ;; Could try rewriting to use easymenu.el or lmenu.el.
1394 ((and (fboundp 'x-popup-menu) (ffap-mouse-event))
1398 (list "" (cons title
1399 (mapcar (function (lambda (i) (cons (car i) i)))
1401 ;; minibuffer with completion buffer:
1403 (let ((minibuffer-setup-hook 'minibuffer-completion-help))
1404 ;; Bug: prompting may assume unique strings, no "".
1407 (format "%s (default %s): " title (car (car alist)))
1409 ;; (cons (car (car alist)) 0)
1411 (sit-for 0) ; redraw original screen
1412 ;; Convert string to its entry, or else the default:
1413 (setq choice (or (assoc choice alist) (car alist))))
1416 (funcall cont choice)
1417 (message "No choice made!") ; possible with menus
1420 (defun ffap-menu-rescan nil
1421 "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
1422 Applies `ffap-menu-text-plist' text properties at all matches."
1424 (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
1425 (range (- (point-max) (point-min)))
1426 (mod (buffer-modified-p)) ; was buffer modified?
1427 buffer-read-only ; to set text-properties
1429 ;; Avoid repeated searches of the *mode-alist:
1430 (major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
1433 (setq ffap-menu-alist nil)
1436 (goto-char (point-min))
1437 (while (setq item (ffap-next-guess))
1438 (setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist))
1439 (add-text-properties (car ffap-string-at-point-region) (point)
1440 ffap-menu-text-plist)
1441 (message "Scanning...%2d%% <%s>"
1442 (/ (* 100 (- (point) (point-min))) range) item)))
1443 (or mod (set-buffer-modified-p nil))))
1444 (message "Scanning...done")
1445 ;; Remove duplicates.
1446 (setq ffap-menu-alist ; sort by item
1447 (sort ffap-menu-alist
1449 (lambda (a b) (string-lessp (car a) (car b))))))
1450 (let ((ptr ffap-menu-alist)) ; remove duplicates
1452 (if (equal (car (car ptr)) (car (car (cdr ptr))))
1453 (setcdr ptr (cdr (cdr ptr)))
1454 (setq ptr (cdr ptr)))))
1455 (setq ffap-menu-alist ; sort by position
1456 (sort ffap-menu-alist
1458 (lambda (a b) (< (cdr a) (cdr b)))))))
1461 ;;; Mouse Support (`ffap-at-mouse'):
1463 ;; See the suggested binding in ffap-bindings (near eof).
1465 (defvar ffap-at-mouse-fallback nil ; ffap-menu? too time-consuming
1466 "Command invoked by `ffap-at-mouse' if nothing found at click, or nil.
1467 Ignored when `ffap-at-mouse' is called programmatically.")
1468 (put 'ffap-at-mouse-fallback 'risky-local-variable t)
1471 (defun ffap-at-mouse (e)
1472 "Find file or url guessed from text around mouse click.
1473 Interactively, calls `ffap-at-mouse-fallback' if nothing is found.
1474 Returns t or nil to indicate success."
1477 ;; Maybe less surprising without the save-excursion?
1480 ;; Would prefer to do nothing unless click was *on* text. How
1481 ;; to tell that the click was beyond the end of current line?
1485 (set-buffer (ffap-event-buffer e))
1489 (sit-for 0) ; display
1490 (message "Finding `%s'" guess)
1491 (find-file-at-point guess)
1492 t) ; success: return non-nil
1493 (ffap-highlight t)))
1495 (if ffap-at-mouse-fallback
1496 (call-interactively ffap-at-mouse-fallback)
1497 (message "No file or url found at mouse click.")))
1498 ;; failure: return nil
1502 ;;; ffap-other-* commands:
1504 ;; Requested by KPC.
1506 ;; There could be a real `ffap-noselect' function, but we would need
1507 ;; at least two new user variables, and there is no w3-fetch-noselect.
1508 ;; So instead, we just fake it with a slow save-window-excursion.
1510 (defun ffap-other-window nil
1511 "Like `ffap', but put buffer in another window.
1512 Only intended for interactive use."
1514 (switch-to-buffer-other-window
1515 (save-window-excursion (call-interactively 'ffap) (current-buffer))))
1517 (defun ffap-other-frame nil
1518 "Like `ffap', but put buffer in another frame.
1519 Only intended for interactive use."
1521 ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1522 (let* ((win (selected-window)) (wdp (window-dedicated-p win)))
1525 (set-window-dedicated-p win nil)
1526 (switch-to-buffer-other-frame
1527 (save-window-excursion
1528 (call-interactively 'ffap)
1530 (set-window-dedicated-p win wdp))))
1536 "Submit a bug report for the ffap package."
1537 ;; Important: keep the version string here in synch with that at top
1538 ;; of file! Could use lisp-mnt from Emacs 19, but that would depend
1539 ;; on being able to find the ffap.el source file.
1542 (let ((reporter-prompt-for-summary-p t))
1543 (reporter-submit-bug-report
1544 "Michelangelo Grigni <mic@mathcs.emory.edu>"
1545 "ffap" ; version? just rely on Emacs version
1546 (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
1548 (fset 'ffap-submit-bug 'ffap-bug) ; another likely name
1551 ;;; Hooks for Gnus, VM, Rmail:
1553 ;; If you do not like these bindings, write versions with whatever
1554 ;; bindings you would prefer.
1556 (defun ffap-ro-mode-hook nil
1557 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
1558 (local-set-key "\M-l" 'ffap-next)
1559 (local-set-key "\M-m" 'ffap-menu)
1562 (defun ffap-gnus-hook nil
1563 "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
1564 (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
1565 ;; Note "l", "L", "m", "M" are taken:
1566 (local-set-key "\M-l" 'ffap-gnus-next)
1567 (local-set-key "\M-m" 'ffap-gnus-menu))
1569 (defun ffap-gnus-wrapper (form) ; used by both commands below
1570 (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
1571 (gnus-summary-select-article)) ; get article of current line
1572 ;; Preserve selected buffer, but do not do save-window-excursion,
1573 ;; since we want to see any window created by the form. Temporarily
1574 ;; select the article buffer, so we can see any point movement.
1575 (let ((sb (window-buffer (selected-window))))
1576 (gnus-configure-windows 'article)
1577 (pop-to-buffer gnus-article-buffer)
1579 ;; Skip headers for ffap-gnus-next (which will wrap around)
1580 (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
1583 (pop-to-buffer sb))))
1585 (defun ffap-gnus-next nil
1586 "Run `ffap-next' in the gnus article buffer."
1587 (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
1589 (defun ffap-gnus-menu nil
1590 "Run `ffap-menu' in the gnus article buffer."
1591 (interactive) (ffap-gnus-wrapper '(ffap-menu)))
1594 ;;; Offer default global bindings (`ffap-bindings'):
1596 (defvar ffap-bindings
1598 (global-set-key [S-mouse-3] 'ffap-at-mouse)
1599 (global-set-key [C-S-mouse-3] 'ffap-menu)
1600 (global-set-key "\C-x\C-f" 'find-file-at-point)
1601 (global-set-key "\C-x4f" 'ffap-other-window)
1602 (global-set-key "\C-x5f" 'ffap-other-frame)
1603 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
1604 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
1605 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
1606 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
1607 ;; (setq dired-x-hands-off-my-keys t) ; the default
1609 "List of binding forms evaluated by function `ffap-bindings'.
1610 A reasonable ffap installation needs just these two lines:
1613 Of course if you do not like these bindings, just roll your own!")
1615 (defun ffap-bindings nil
1616 "Evaluate the forms in variable `ffap-bindings'."
1617 (eval (cons 'progn ffap-bindings)))
1619 ;; Example modifications:
1621 ;; (setq ffap-alist ; remove a feature in `ffap-alist'
1622 ;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
1624 ;; (setq ffap-alist ; add something to `ffap-alist'
1626 ;; (cons "^YSN[0-9]+$"
1627 ;; (defun ffap-ysn (name)
1629 ;; "http://www.physics.uiuc.edu/"
1630 ;; "ysn/httpd/htdocs/ysnarchive/issuefiles/"
1631 ;; (substring name 3) ".html")))
1635 ;;; ffap.el ends here