1 ;;; ffap.el --- find file (or url) at point
3 ;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
8 ;; Created: 29 Mar 1993
9 ;; Keywords: files, hypermedia, matching, mouse, convenience
10 ;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 3, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
32 ;; Command find-file-at-point replaces find-file. With a prefix, it
33 ;; behaves exactly like find-file. Without a prefix, it first tries
34 ;; to guess a default file or URL from the text around the point
35 ;; (`ffap-require-prefix' swaps these behaviors). This is useful for
36 ;; following references in situations such as mail or news buffers,
37 ;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
40 ;; For the default installation, add this line to your .emacs file:
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 C-r ffap-read-only
48 ;; C-x C-v ffap-alternate-file
50 ;; C-x d dired-at-point
51 ;; C-x C-d ffap-list-directory
53 ;; C-x 4 f ffap-other-window
54 ;; C-x 4 r ffap-read-only-other-window
55 ;; C-x 4 d ffap-dired-other-window
57 ;; C-x 5 f ffap-other-frame
58 ;; C-x 5 r ffap-read-only-other-frame
59 ;; C-x 5 d ffap-dired-other-frame
61 ;; S-mouse-3 ffap-at-mouse
62 ;; C-S-mouse-3 ffap-menu
64 ;; ffap-bindings also adds hooks to make the following local bindings
65 ;; in vm, gnus, and rmail:
67 ;; M-l ffap-next, or ffap-gnus-next in gnus (l == "link")
68 ;; M-m ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
70 ;; If you do not like these bindings, modify the variable
71 ;; `ffap-bindings', or write your own.
73 ;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
74 ;; to load or autoload them before ffap. If you use ff-paths, load it
75 ;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many
76 ;; option variables. In particular, if ffap is slow, try these:
78 ;; (setq ffap-alist nil) ; faster, dumber prompting
79 ;; (setq ffap-machine-p-known 'accept) ; no pinging
80 ;; (setq ffap-url-regexp nil) ; disable URL features in ffap
81 ;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping
83 ;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
84 ;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
85 ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
86 ;; the file and URL references within a buffer.
91 ;; The History and Contributors moved to ffap.LOG (same ftp site),
92 ;; which also has some old examples and commentary from ffap 1.5.
97 ;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file
98 ;; * find file of symbol if TAGS is loaded (like above)
99 ;; * break long menus into multiple panes (like imenu?)
100 ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
101 ;; * notice "machine.dom blah blah blah dir/file" (how?)
102 ;; * as w3 becomes standard, rewrite to rely more on its functions
103 ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
104 ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
105 ;; * handle "$(VAR)" in Makefiles
106 ;; * use the font-lock machinery
113 ;; Please do not delete this variable, it is checked in bug reports.
114 (defconst ffap-version
"1.9-fsf <97/06/25 13:21:41 mic>"
115 "The version of ffap: \"Major.Minor-Build <Timestamp>\"")
119 "Find file or URL at point."
120 :link
'(url-link :tag
"URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/")
124 ;; The code is organized in pages, separated by formfeed characters.
125 ;; See the next two pages for standard customization ideas.
130 (defun ffap-soft-value (name &optional default
)
131 "Return value of symbol with NAME, if it is interned.
132 Otherwise return nil (or the optional DEFAULT value)."
133 ;; Bug: (ffap-soft-value "nil" 5) --> 5
134 (let ((sym (intern-soft name
)))
135 (if (and sym
(boundp sym
)) (symbol-value sym
) default
)))
137 (defcustom ffap-shell-prompt-regexp
138 ;; This used to test for some shell prompts that don't have a space
139 ;; after them. The common root shell prompt (#) is not listed since it
140 ;; also doubles up as a valid URL character.
142 "Paths matching this regexp are stripped off the shell prompt
143 If nil, ffap doesn't do shell prompt stripping."
144 :type
'(choice (const :tag
"Disable" nil
)
145 (const :tag
"Standard" "[$%><]*")
149 (defcustom ffap-ftp-regexp
150 ;; This used to test for ange-ftp or efs being present, but it should be
151 ;; harmless (and simpler) to give it this value unconditionally.
153 "*File names matching this regexp are treated as remote ffap.
154 If nil, ffap neither recognizes nor generates such names."
155 :type
'(choice (const :tag
"Disable" nil
)
156 (const :tag
"Standard" "\\`/[^/:]+:")
160 (defcustom ffap-url-unwrap-local t
161 "*If non-nil, convert `file:' URL to local file name before prompting."
165 (defcustom ffap-url-unwrap-remote t
166 "*If non-nil, convert `ftp:' URL to remote file name before prompting.
167 This is ignored if `ffap-ftp-regexp' is nil."
171 (defcustom ffap-ftp-default-user
"anonymous"
172 "*User name in ftp file names generated by `ffap-host-to-path'.
173 Note this name may be omitted if it equals the default
174 \(either `efs-default-user' or `ange-ftp-default-user'\)."
178 (defcustom ffap-rfs-regexp
179 ;; Remote file access built into file system? HP rfa or Andrew afs:
180 "\\`/\\(afs\\|net\\)/."
181 ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
182 "*Matching file names are treated as remote. Use nil to disable."
186 (defvar ffap-url-regexp
187 ;; Could just use `url-nonrelative-link' of w3, if loaded.
188 ;; This regexp is not exhaustive, it just matches common cases.
191 "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
193 "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
194 "\\)." ; require one more character
196 "Regexp matching URL's. nil to disable URL features in ffap.")
198 (defcustom ffap-foo-at-bar-prefix
"mailto"
199 "*Presumed URL prefix type of strings like \"<foo.9z@bar>\".
200 Sensible values are nil, \"news\", or \"mailto\"."
201 :type
'(choice (const "mailto")
203 (const :tag
"Disable" nil
)
204 ;; string -- possible, but not really useful
209 ;;; Peanut Gallery (More User Variables):
211 ;; Users of ffap occasionally suggest new features. If I consider
212 ;; those features interesting but not clear winners (a matter of
213 ;; personal taste) I try to leave options to enable them. Read
214 ;; through this section for features that you like, put an appropriate
215 ;; enabler in your .emacs file.
217 (defcustom ffap-dired-wildcards
"[*?][^/]*\\'"
218 "*A regexp matching filename wildcard characters, or nil.
220 If `find-file-at-point' gets a filename matching this pattern,
221 and `ffap-pass-wildcards-to-dired' is nil, it passes it on to
222 `find-file' with non-nil WILDCARDS argument, which expands
223 wildcards and visits multiple files. To visit a file whose name
224 contains wildcard characters you can suppress wildcard expansion
225 by setting `find-file-wildcards'. If `find-file-at-point' gets a
226 filename matching this pattern and `ffap-pass-wildcards-to-dired'
227 is non-nil, it passes it on to `dired'.
229 If `dired-at-point' gets a filename matching this pattern,
230 it passes it on to `dired'."
231 :type
'(choice (const :tag
"Disable" nil
)
232 (const :tag
"Enable" "[*?][^/]*\\'")
233 ;; regexp -- probably not useful
237 (defcustom ffap-pass-wildcards-to-dired nil
238 "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired."
242 (defcustom ffap-newfile-prompt nil
243 ;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is
244 ;; better handled by `find-file-not-found-hooks'.
245 "*Whether `find-file-at-point' prompts about a nonexistent file."
249 (defcustom ffap-require-prefix nil
250 ;; Suggestion from RHOGEE, 20 Oct 1994.
251 "*If set, reverses the prefix argument to `find-file-at-point'.
252 This is nil so neophytes notice ffap. Experts may prefer to disable
253 ffap most of the time."
257 (defcustom ffap-file-finder
'find-file
258 "*The command called by `find-file-at-point' to find a file."
261 (put 'ffap-file-finder
'risky-local-variable t
)
263 (defcustom ffap-directory-finder
'dired
264 "*The command called by `dired-at-point' to find a directory."
267 (put 'ffap-directory-finder
'risky-local-variable t
)
269 (defcustom ffap-url-fetcher
270 (if (fboundp 'browse-url
)
271 'browse-url
; rely on browse-url-browser-function
273 ;; Remote control references:
274 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
275 ;; http://home.netscape.com/newsref/std/x-remote.html
276 "*A function of one argument, called by ffap to fetch an URL.
277 Reasonable choices are `w3-fetch' or a `browse-url-*' function.
278 For a fancy alternative, get `ffap-url.el'."
279 :type
'(choice (const w3-fetch
)
280 (const browse-url
) ; in recent versions of browse-url
281 (const browse-url-netscape
)
282 (const browse-url-mosaic
)
285 (put 'ffap-url-fetcher
'risky-local-variable t
)
290 ;; This version of ffap supports only the Emacs it is distributed in.
291 ;; See the ftp site for a more general version. The following
292 ;; functions are necessary "leftovers" from the more general version.
294 (defun ffap-mouse-event nil
; current mouse event, or nil
295 (and (listp last-nonmenu-event
) last-nonmenu-event
))
296 (defun ffap-event-buffer (event)
297 (window-buffer (car (event-start event
))))
300 ;;; Find Next Thing in buffer (`ffap-next'):
302 ;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
303 ;; then, broke it up into ffap-next-guess (noninteractive) and
304 ;; ffap-next (a command). It now work on files as well as url's.
306 (defcustom ffap-next-regexp
307 ;; If you want ffap-next to find URL's only, try this:
308 ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
309 ;; (concat "\\<" (substring ffap-url-regexp 2))))
311 ;; It pays to put a big fancy regexp here, since ffap-guesser is
312 ;; much more time-consuming than regexp searching:
313 "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
314 "*Regular expression governing movements of `ffap-next'."
318 (defvar ffap-next-guess nil
319 "Last value returned by `ffap-next-guess'.")
321 (defvar ffap-string-at-point-region
'(1 1)
322 "List (BEG END), last region returned by `ffap-string-at-point'.")
324 (defun ffap-next-guess (&optional back lim
)
325 "Move point to next file or URL, and return it as a string.
326 If nothing is found, leave point at limit and return nil.
327 Optional BACK argument makes search backwards.
328 Optional LIM argument limits the search.
329 Only considers strings that match `ffap-next-regexp'."
330 (or lim
(setq lim
(if back
(point-min) (point-max))))
332 (while (not (or guess
(eq (point) lim
)))
333 (funcall (if back
're-search-backward
're-search-forward
)
334 ffap-next-regexp lim
'move
)
335 (setq guess
(ffap-guesser)))
336 ;; Go to end, so we do not get same guess twice:
337 (goto-char (nth (if back
0 1) ffap-string-at-point-region
))
338 (setq ffap-next-guess guess
)))
341 (defun ffap-next (&optional back wrap
)
342 "Search buffer for next file or URL, and run ffap.
343 Optional argument BACK says to search backwards.
344 Optional argument WRAP says to try wrapping around if necessary.
345 Interactively: use a single prefix to search backwards,
346 double prefix to wrap forward, triple to wrap backwards.
347 Actual search is done by `ffap-next-guess'."
349 (cdr (assq (prefix-numeric-value current-prefix-arg
)
350 '((1) (4 t
) (16 nil t
) (64 t t
)))))
352 (guess (ffap-next-guess back
)))
353 ;; Try wraparound if necessary:
354 (and (not guess
) wrap
355 (goto-char (if back
(point-max) (point-min)))
356 (setq guess
(ffap-next-guess back pt
)))
359 (sit-for 0) ; display point movement
360 (find-file-at-point (ffap-prompter guess
)))
361 (goto-char pt
) ; restore point
362 (message "No %sfiles or URL's found"
363 (if wrap
"" "more ")))))
365 (defun ffap-next-url (&optional back wrap
)
366 "Like `ffap-next', but search with `ffap-url-regexp'."
368 (let ((ffap-next-regexp ffap-url-regexp
))
370 (call-interactively 'ffap-next
)
371 (ffap-next back wrap
))))
374 ;;; Machines (`ffap-machine-p'):
376 ;; I cannot decide a "best" strategy here, so these are variables. In
377 ;; particular, if `Pinging...' is broken or takes too long on your
378 ;; machine, try setting these all to accept or reject.
379 (defcustom ffap-machine-p-local
'reject
; this happens often
380 "*What `ffap-machine-p' does with hostnames that have no domain.
381 Value should be a symbol, one of `ping', `accept', and `reject'."
382 :type
'(choice (const ping
)
386 (defcustom ffap-machine-p-known
'ping
; `accept' for higher speed
387 "*What `ffap-machine-p' does with hostnames that have a known domain.
388 Value should be a symbol, one of `ping', `accept', and `reject'.
389 See `mail-extr.el' for the known domains."
390 :type
'(choice (const ping
)
394 (defcustom ffap-machine-p-unknown
'reject
395 "*What `ffap-machine-p' does with hostnames that have an unknown domain.
396 Value should be a symbol, one of `ping', `accept', and `reject'.
397 See `mail-extr.el' for the known domains."
398 :type
'(choice (const ping
)
403 (defun ffap-what-domain (domain)
404 ;; Like what-domain in mail-extr.el, returns string or nil.
406 (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains")
407 (ffap-soft-value "all-top-level-domains")))) ; XEmacs
408 (and ob
(get (intern-soft (downcase domain
) ob
) 'domain-name
))))
410 (defun ffap-machine-p (host &optional service quiet strategy
)
411 "Decide whether HOST is the name of a real, reachable machine.
412 Depending on the domain (none, known, or unknown), follow the strategy
413 named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
414 or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
415 Optional SERVICE specifies the port used \(default \"discard\"\).
416 Optional QUIET flag suppresses the \"Pinging...\" message.
417 Optional STRATEGY overrides the three variables above.
419 t means that HOST answered.
420 'accept means the relevant variable told us to accept.
421 \"mesg\" means HOST exists, but does not respond for some reason."
422 ;; Try some (Emory local):
423 ;; (ffap-machine-p "ftp" nil nil 'ping)
424 ;; (ffap-machine-p "nonesuch" nil nil 'ping)
425 ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
426 ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
427 ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
428 ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
429 (if (or (string-match "[^-[:alnum:].]" host
) ; Illegal chars (?)
430 (not (string-match "[^0-9]" host
))) ; 1: a number? 2: quick reject
433 (and (string-match "\\.[^.]*$" host
)
434 (downcase (substring host
(1+ (match-beginning 0))))))
435 (what-domain (if domain
(ffap-what-domain domain
) "Local")))
438 (cond ((not domain
) ffap-machine-p-local
)
439 ((not what-domain
) ffap-machine-p-unknown
)
440 (t ffap-machine-p-known
))))
442 ((eq strategy
'accept
) 'accept
)
443 ((eq strategy
'reject
) nil
)
444 ((not (fboundp 'open-network-stream
)) nil
)
445 ;; assume (eq strategy 'ping)
448 (if (stringp what-domain
)
449 (message "Pinging %s (%s)..." host what-domain
)
450 (message "Pinging %s ..." host
)))
451 (condition-case error
455 "ffap-machine-p" nil host
(or service
"discard")))
458 (let ((mesg (car (cdr error
))))
461 ((string-match "^Unknown host" mesg
) nil
)
462 ((string-match "not responding$" mesg
) mesg
)
464 ;; (file-error "connection failed" "permission denied"
465 ;; "nonesuch" "ffap-machine-p")
466 ;; (file-error "connection failed" "host is unreachable"
467 ;; "gopher.house.gov" "ffap-machine-p")
468 ;; (file-error "connection failed" "address already in use"
469 ;; "ftp.uu.net" "ffap-machine-p")
470 ((equal mesg
"connection failed")
471 (if (equal (nth 2 error
) "permission denied")
472 nil
; host does not exist
473 ;; Other errors mean the host exists:
475 ;; Could be "Unknown service":
476 (t (signal (car error
) (cdr error
))))))))))))
479 ;;; Possibly Remote Resources:
481 (defun ffap-replace-file-component (fullname name
)
482 "In remote FULLNAME, replace path with NAME. May return nil."
483 ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
486 (function (lambda (sym) (and (fboundp sym
) (setq found sym
))))
488 efs-replace-path-component
489 ange-ftp-replace-path-component
490 ange-ftp-replace-name-component
493 (fset 'ffap-replace-file-component found
)
494 (funcall found fullname name
))))
495 ;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new")
497 (defun ffap-file-suffix (file)
498 "Return trailing `.foo' suffix of FILE, or nil if none."
499 (let ((pos (string-match "\\.[^./]*\\'" file
)))
500 (and pos
(substring file pos nil
))))
502 (defvar ffap-compression-suffixes
'(".gz" ".Z") ; .z is mostly dead
503 "List of suffixes tried by `ffap-file-exists-string'.")
505 (defun ffap-file-exists-string (file &optional nomodify
)
506 ;; Early jka-compr versions modified file-exists-p to return the
507 ;; filename, maybe modified by adding a suffix like ".gz". That
508 ;; broke the interface of file-exists-p, so it was later dropped.
509 ;; Here we document and simulate the old behavior.
510 "Return FILE (maybe modified) if the file exists, else nil.
511 When using jka-compr (a.k.a. `auto-compression-mode'), the returned
512 name may have a suffix added from `ffap-compression-suffixes'.
513 The optional NOMODIFY argument suppresses the extra search."
515 ((not file
) nil
) ; quietly reject nil
516 ((file-exists-p file
) file
) ; try unmodified first
517 ;; three reasons to suppress search:
519 ((not (rassq 'jka-compr-handler file-name-handler-alist
)) nil
)
520 ((member (ffap-file-suffix file
) ffap-compression-suffixes
) nil
)
521 (t ; ok, do the search
522 (let ((list ffap-compression-suffixes
) try ret
)
524 (if (file-exists-p (setq try
(concat file
(car list
))))
525 (setq ret try list nil
)
526 (setq list
(cdr list
))))
529 (defun ffap-file-remote-p (filename)
530 "If FILENAME looks remote, return it (maybe slightly improved)."
531 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
532 ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir")
533 ;; (ffap-file-remote-p "/ffap.el:80")
534 (or (and ffap-ftp-regexp
535 (string-match ffap-ftp-regexp filename
)
536 ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing
537 ;; practice of advertising ftp files as "host.dom://filename".
538 (if (string-match "//" filename
)
539 ;; (replace-match "/" nil nil filename)
540 (concat (substring filename
0 (1+ (match-beginning 0)))
541 (substring filename
(match-end 0)))
544 (string-match ffap-rfs-regexp filename
)
547 (defun ffap-machine-at-point nil
548 "Return machine name at point if it exists, or nil."
549 (let ((mach (ffap-string-at-point 'machine
)))
550 (and (ffap-machine-p mach
) mach
)))
552 (defsubst ffap-host-to-filename
(host)
553 "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
554 Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
555 (if (equal host
"localhost")
557 (let ((user ffap-ftp-default-user
))
558 ;; Avoid including the user if it is same as default:
559 (if (or (equal user
(ffap-soft-value "ange-ftp-default-user"))
560 (equal user
(ffap-soft-value "efs-default-user")))
562 (concat "/" user
(and user
"@") host
":"))))
564 (defun ffap-fixup-machine (mach)
565 ;; Convert a hostname into an url, an ftp file name, or nil.
567 ((not (and ffap-url-regexp
(stringp mach
))) nil
)
569 ((string-match "\\`gopher[-.]" mach
) ; or "info"?
570 (concat "gopher://" mach
"/"))
572 ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach
))
573 (concat "http://" mach
"/"))
574 ;; More cases? Maybe "telnet:" for archie?
575 (ffap-ftp-regexp (ffap-host-to-filename mach
))
578 (defvar ffap-newsgroup-regexp
"^[[:lower:]]+\\.[-+[:lower:]_0-9.]+$"
579 "Strings not matching this fail `ffap-newsgroup-p'.")
580 (defvar ffap-newsgroup-heads
; entirely inadequate
581 '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
582 "Used by `ffap-newsgroup-p' if gnus is not running.")
584 (defun ffap-newsgroup-p (string)
585 "Return STRING if it looks like a newsgroup name, else nil."
587 (string-match ffap-newsgroup-regexp string
)
588 (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb
))
589 (heads ffap-newsgroup-heads
)
592 (setq htb
(car htbs
) htbs
(cdr htbs
))
595 ;; errs: htb symbol may be unbound, or not a hash-table.
596 ;; gnus-gethash is just a macro for intern-soft.
597 (and (symbol-value htb
)
598 (intern-soft string
(symbol-value htb
))
599 (setq ret string htbs nil
))
600 ;; If we made it this far, gnus is running, so ignore "heads":
604 (let ((head (string-match "\\`\\([[:lower:]]+\\)\\." string
)))
605 (and head
(setq head
(substring string
0 (match-end 1)))
608 ;; Is there ever a need to modify string as a newsgroup name?
611 (defsubst ffap-url-p
(string)
612 "If STRING looks like an url, return it (maybe improved), else nil."
613 (let ((case-fold-search t
))
614 (and ffap-url-regexp
(string-match ffap-url-regexp string
)
615 ;; I lied, no improvement:
618 ;; Broke these out of ffap-fixup-url, for use of ffap-url package.
619 (defsubst ffap-url-unwrap-local
(url)
620 "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
621 (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url
)
622 (substring url
(1+ (match-end 1)))))
623 (defsubst ffap-url-unwrap-remote
(url)
624 "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
625 (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url
)
627 (ffap-host-to-filename (substring url
(match-beginning 2) (match-end 2)))
628 (substring url
(match-beginning 3) (match-end 3)))))
629 ;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
631 (defun ffap-fixup-url (url)
632 "Clean up URL and return it, maybe as a file name."
634 ((not (stringp url
)) nil
)
635 ((and ffap-url-unwrap-local
(ffap-url-unwrap-local url
)))
636 ((and ffap-url-unwrap-remote ffap-ftp-regexp
637 (ffap-url-unwrap-remote url
)))
638 ((fboundp 'url-normalize-url
) ; may autoload url (part of w3)
639 (url-normalize-url url
))
643 ;;; File Name Handling:
645 ;; The upcoming ffap-alist actions need various utilities to prepare
646 ;; and search directories. Too many features here.
648 ;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
649 ;; (defun ffap-splice (func inlist)
650 ;; "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
651 ;; (let* ((head (cons 17 nil)) (last head))
653 ;; (setcdr last (funcall func (car inlist)))
654 ;; (setq last (ffap-last last) inlist (cdr inlist)))
657 (defun ffap-list-env (env &optional empty
)
658 "Return a list of strings parsed from environment variable ENV.
659 Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
660 also is substituted for the first empty-string component, if there is one.
661 Uses `path-separator' to separate the path into substrings."
662 ;; We cannot use parse-colon-path (files.el), since it kills
663 ;; "//" entries using file-name-as-directory.
664 ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
665 ;; in ff-paths and bib-cite. The EMPTY arg may help mimic kpathsea.
666 (if (or empty
(getenv env
)) ; should return something
667 (let ((start 0) match dir ret
)
668 (setq env
(concat (getenv env
) path-separator
))
669 (while (setq match
(string-match path-separator env start
))
670 (setq dir
(substring env start match
) start
(1+ match
))
671 ;;(and (file-directory-p dir) (not (member dir ret)) ...)
672 (setq ret
(cons dir ret
)))
673 (setq ret
(nreverse ret
))
674 (and empty
(setq match
(member "" ret
))
675 (progn ; allow string or list here
676 (setcdr match
(append (cdr-safe empty
) (cdr match
)))
677 (setcar match
(or (car-safe empty
) empty
))))
680 (defun ffap-reduce-path (path)
681 "Remove duplicates and non-directories from PATH list."
684 (setq tem path path
(cdr path
))
685 (if (equal (car tem
) ".") (setcar tem
""))
686 (or (member (car tem
) ret
)
687 (not (file-directory-p (car tem
)))
688 (progn (setcdr tem ret
) (setq ret tem
))))
691 (defun ffap-all-subdirs (dir &optional depth
)
692 "Return list all subdirectories under DIR, starting with itself.
693 Directories beginning with \".\" are ignored, and directory symlinks
694 are listed but never searched (to avoid loops).
695 Optional DEPTH limits search depth."
696 (and (file-exists-p dir
)
697 (ffap-all-subdirs-loop (expand-file-name dir
) (or depth -
1))))
699 (defun ffap-all-subdirs-loop (dir depth
) ; internal
700 (setq depth
(1- depth
))
702 (and (not (eq depth -
1))
708 ((not (file-directory-p d
)) nil
)
709 ((file-symlink-p d
) (list d
))
710 (t (ffap-all-subdirs-loop d depth
)))))
711 (directory-files dir t
"\\`[^.]")
714 (defvar ffap-kpathsea-depth
1
715 "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
716 Set to 0 to avoid all searching, or nil for no limit.")
718 (defun ffap-kpathsea-expand-path (path)
719 "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs.
720 The subdirs begin with the original directory, and the depth of the
721 search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
722 kpathsea, a library used by some versions of TeX."
727 (if (string-match "[^/]//\\'" dir
)
728 (ffap-all-subdirs (substring dir
0 -
2) ffap-kpathsea-depth
)
732 (defun ffap-locate-file (file &optional nosuffix path dir-ok
)
733 ;; The current version of locate-library could almost replace this,
734 ;; except it does not let us override the suffix list. The
735 ;; compression-suffixes search moved to ffap-file-exists-string.
736 "A generic path-searching function, mimics `load' by default.
737 Returns path to file that \(load FILE\) would load, or nil.
738 Optional NOSUFFIX, if nil or t, is like the fourth argument
739 for load: whether to try the suffixes (\".elc\" \".el\" \"\").
740 If a nonempty list, it is a list of suffixes to try instead.
741 Optional PATH is a list of directories instead of `load-path'.
742 Optional DIR-OK means that returning a directory is allowed,
743 DIR-OK is already implicit if FILE looks like a directory.
745 This uses ffap-file-exists-string, which may try adding suffixes from
746 `ffap-compression-suffixes'."
747 (or path
(setq path load-path
))
748 (or dir-ok
(setq dir-ok
(equal "" (file-name-nondirectory file
))))
749 (if (file-name-absolute-p file
)
750 (setq path
(list (file-name-directory file
))
751 file
(file-name-nondirectory file
)))
752 (let ((suffixes-to-try
754 ((consp nosuffix
) nosuffix
)
756 (t '(".elc" ".el" ""))))
759 (setq suffixes suffixes-to-try
)
761 (setq try
(ffap-file-exists-string
763 (concat file
(car suffixes
)) (car path
))))
764 (if (and try
(or dir-ok
(not (file-directory-p try
))))
765 (setq found try suffixes nil path nil
)
766 (setq suffixes
(cdr suffixes
))))
767 (setq path
(cdr path
)))
771 ;;; Action List (`ffap-alist'):
773 ;; These search actions depend on the major-mode or regexps matching
774 ;; the current name. The little functions and their variables are
775 ;; deferred to the next section, at some loss of "code locality". A
776 ;; good example of featuritis. Trim this list for speed.
780 ("" . ffap-completable
) ; completion, slow on some systems
781 ("\\.info\\'" . ffap-info
) ; gzip.info
782 ("\\`info/" . ffap-info-2
) ; info/emacs
783 ("\\`[-[:lower:]]+\\'" . ffap-info-3
) ; (emacs)Top [only in the parentheses]
784 ("\\.elc?\\'" . ffap-el
) ; simple.el, simple.elc
785 (emacs-lisp-mode . ffap-el-mode
) ; rmail, gnus, simple, custom
786 ;; (lisp-interaction-mode . ffap-el-mode) ; maybe
787 (finder-mode . ffap-el-mode
) ; type {C-h p} and try it
788 (help-mode . ffap-el-mode
) ; maybe useful
789 (c++-mode . ffap-c-mode
) ; search ffap-c-path
790 (cc-mode . ffap-c-mode
) ; same
791 ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode
) ; stdio.h
792 (fortran-mode . ffap-fortran-mode
) ; FORTRAN requested by MDB
793 ("\\.[fF]\\'" . ffap-fortran-mode
)
794 (tex-mode . ffap-tex-mode
) ; search ffap-tex-path
795 (latex-mode . ffap-latex-mode
) ; similar
796 ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex
)
797 ("\\.bib\\'" . ffap-bib
) ; search ffap-bib-path
798 ("\\`\\." . ffap-home
) ; .emacs, .bashrc, .profile
799 ("\\`~/" . ffap-lcd
) ; |~/misc/ffap.el.Z|
800 ;; This uses to have a blank, but ffap-string-at-point doesn't
802 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html
803 ("^[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $
804 . ffap-rfc
) ; "100% RFC2100 compliant"
805 (dired-mode . ffap-dired
) ; maybe in a subdirectory
807 "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
808 If string NAME at point (maybe \"\") is not a file or url, these pairs
809 specify actions to try creating such a string. A pair matches if either
810 KEY is a symbol, and it equals `major-mode', or
811 KEY is a string, it should matches NAME as a regexp.
812 On a match, \(FUNCTION NAME\) is called and should return a file, an
813 url, or nil. If nil, search the alist for further matches.")
815 (put 'ffap-alist
'risky-local-variable t
)
817 ;; Example `ffap-alist' modifications:
819 ;; (setq ffap-alist ; remove a feature in `ffap-alist'
820 ;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
822 ;; (setq ffap-alist ; add something to `ffap-alist'
824 ;; (cons "^YSN[0-9]+$"
825 ;; (defun ffap-ysn (name)
827 ;; "http://www.physics.uiuc.edu/"
828 ;; "ysn/httpd/htdocs/ysnarchive/issuefiles/"
829 ;; (substring name 3) ".html")))
833 ;;; Action Definitions:
835 ;; Define various default members of `ffap-alist'.
837 (defun ffap-completable (name)
838 (let* ((dir (or (file-name-directory name
) default-directory
))
839 (cmp (file-name-completion (file-name-nondirectory name
) dir
)))
840 (and cmp
(concat dir cmp
))))
842 (defun ffap-home (name) (ffap-locate-file name t
'("~")))
844 (defun ffap-info (name)
847 (or (ffap-soft-value "Info-directory-list")
848 (ffap-soft-value "Info-default-directory-list")
851 (defun ffap-info-2 (name) (ffap-info (substring name
5)))
853 (defun ffap-info-3 (name)
854 ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
855 (and (equal (ffap-string-around) "()") (ffap-info name
)))
857 (defun ffap-el (name) (ffap-locate-file name t
))
859 (defun ffap-el-mode (name)
860 ;; If name == "foo.el" we will skip it, since ffap-el already
861 ;; searched for it once. (This assumes the default ffap-alist.)
862 (and (not (string-match "\\.el\\'" name
))
863 (ffap-locate-file name
'(".el"))))
866 ;; Need smarter defaults here! Suggestions welcome.
867 '("/usr/include" "/usr/local/include"))
868 (defun ffap-c-mode (name)
869 (ffap-locate-file name t ffap-c-path
))
871 (defvar ffap-fortran-path
'("../include" "/usr/include"))
873 (defun ffap-fortran-mode (name)
874 (ffap-locate-file name t ffap-fortran-path
))
876 (defvar ffap-tex-path
877 t
; delayed initialization
878 "Path where `ffap-tex-mode' looks for tex files.
879 If t, `ffap-tex-init' will initialize this when needed.")
881 (defun ffap-tex-init nil
882 ;; Compute ffap-tex-path if it is now t.
883 (and (eq t ffap-tex-path
)
884 ;; this may be slow, so say something
885 (message "Initializing ffap-tex-path ...")
890 (ffap-kpathsea-expand-path
892 (ffap-list-env "TEXINPUTS")
893 ;; (ffap-list-env "BIBINPUTS")
895 "TeX-macro-global" ; AUCTeX
896 '("/usr/local/lib/tex/macros"
897 "/usr/local/lib/tex/inputs")))))))))
899 (defun ffap-tex-mode (name)
901 (ffap-locate-file name
'(".tex" "") ffap-tex-path
))
903 (defun ffap-latex-mode (name)
905 ;; only rare need for ""
906 (ffap-locate-file name
'(".cls" ".sty" ".tex" "") ffap-tex-path
))
908 (defun ffap-tex (name)
910 (ffap-locate-file name t ffap-tex-path
))
912 (defvar ffap-bib-path
913 (ffap-list-env "BIBINPUTS"
916 ;; a few wild guesses, need better
917 "/usr/local/lib/tex/macros/bib" ; Solaris?
918 "/usr/lib/texmf/bibtex/bib" ; Linux?
921 (defun ffap-bib (name)
922 (ffap-locate-file name t ffap-bib-path
))
924 (defun ffap-dired (name)
925 (let ((pt (point)) dir try
)
929 (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
930 (re-search-backward "^ *$" nil t
)
931 (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t
)
937 (match-beginning 1) (match-end 1)))))
940 ;; Maybe a "Lisp Code Directory" reference:
941 (defun ffap-lcd (name)
944 ;; lisp-dir-apropos output buffer:
945 (string-match "Lisp Code Dir" (buffer-name))
946 ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
947 ;; or maybe the holy LCD-Datafile itself:
948 (member (ffap-string-around) '("||" "|\n")))
950 ;; lispdir.el may not be loaded yet:
951 (ffap-host-to-filename
952 (ffap-soft-value "elisp-archive-host"
953 "archive.cis.ohio-state.edu"))
954 (file-name-as-directory
955 (ffap-soft-value "elisp-archive-directory"
956 "/pub/gnu/emacs/elisp-archive/"))
957 (substring name
2))))
959 (defvar ffap-rfc-path
960 (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt"))
962 (defun ffap-rfc (name)
963 (format ffap-rfc-path
964 (substring name
(match-beginning 1) (match-end 1))))
967 ;;; At-Point Functions:
969 (defvar ffap-string-at-point-mode-alist
971 ;; The default, used when the `major-mode' is not found.
972 ;; Slightly controversial decisions:
973 ;; * strip trailing "@" and ":"
974 ;; * no commas (good for latex)
975 (file "--:\\\\$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:")
976 ;; An url, or maybe a email/news message-id:
977 (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?")
978 ;; Find a string that does *not* contain a colon:
979 (nocolon "--9$+<>@-Z_[:lower:]~" "<@" "@>;.,!?")
981 (machine "-[:alnum:]." "" ".")
982 ;; Mathematica paths: allow backquotes
983 (math-mode ",-:$+<>@-Z_[:lower:]~`" "<" "@>;.,!?`:")
985 "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
986 possibly a major-mode name, or one of the symbol
987 `file', `url', `machine', and `nocolon'.
988 `ffap-string-at-point' uses the data fields as follows:
989 1. find a maximal string of CHARS around point,
990 2. strip BEG chars before point from the beginning,
991 3. Strip END chars after point from the end.")
993 (defvar ffap-string-at-point nil
994 ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
995 "Last string returned by `ffap-string-at-point'.")
997 (defun ffap-string-at-point (&optional mode
)
998 "Return a string of characters from around point.
999 MODE (defaults to value of `major-mode') is a symbol used to look up string
1000 syntax parameters in `ffap-string-at-point-mode-alist'.
1001 If MODE is not found, we use `file' instead of MODE.
1002 If the region is active, return a string from the region.
1003 Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
1006 (or (assq (or mode major-mode
) ffap-string-at-point-mode-alist
)
1007 (assq 'file ffap-string-at-point-mode-alist
))))
1010 (if (and transient-mark-mode mark-active
)
1012 (setcar ffap-string-at-point-region
(region-beginning))
1013 (setcar (cdr ffap-string-at-point-region
) (region-end)))
1016 (skip-chars-backward (car args
))
1017 (skip-chars-forward (nth 1 args
) pt
)
1018 (setcar ffap-string-at-point-region
(point)))
1020 (skip-chars-forward (car args
))
1021 (skip-chars-backward (nth 2 args
) pt
)
1022 (setcar (cdr ffap-string-at-point-region
) (point)))))))
1023 (set-text-properties 0 (length str
) nil str
)
1024 (setq ffap-string-at-point str
)))
1026 (defun ffap-string-around nil
1027 ;; Sometimes useful to decide how to treat a string.
1028 "Return string of two chars around last `ffap-string-at-point'.
1029 Assumes the buffer has not changed."
1033 (goto-char (car ffap-string-at-point-region
))
1034 (preceding-char)) ; maybe 0
1036 (goto-char (nth 1 ffap-string-at-point-region
))
1037 (following-char)) ; maybe 0
1040 (defun ffap-copy-string-as-kill (&optional mode
)
1041 ;; Requested by MCOOK. Useful?
1042 "Call `ffap-string-at-point', and copy result to `kill-ring'."
1044 (let ((str (ffap-string-at-point mode
)))
1046 (message "No string found around point.")
1048 ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
1049 (message "Copied to kill ring: %s" str
))))
1052 (declare-function w3-view-this-url
"ext:w3" (&optional no-show
))
1054 (defun ffap-url-at-point nil
1055 "Return url from around point if it exists, or nil."
1056 ;; Could use w3's url-get-url-at-point instead. Both handle "URL:",
1057 ;; ignore non-relative links, trim punctuation. The other will
1058 ;; actually look back if point is in whitespace, but I would rather
1059 ;; ffap be less aggressive in such situations.
1063 ;; In a w3 buffer button?
1064 (and (eq major-mode
'w3-mode
)
1065 ;; interface recommended by wmperry:
1066 (w3-view-this-url t
))
1067 ;; Is there a reason not to strip trailing colon?
1068 (let ((name (ffap-string-at-point 'url
)))
1070 ((string-match "^url:" name
) (setq name
(substring name
4)))
1071 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name
)
1072 ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
1073 ;; Without "<>" it must be "mailto". Otherwise could be
1074 ;; either, so consult `ffap-foo-at-bar-prefix'.
1075 (let ((prefix (if (and (equal (ffap-string-around) "<>")
1076 ;; Expect some odd characters:
1077 (string-match "[$.0-9].*[$.0-9].*@" name
))
1079 ffap-foo-at-bar-prefix
1081 (and prefix
(setq name
(concat prefix
":" name
))))))
1082 ((ffap-newsgroup-p name
) (setq name
(concat "news:" name
)))
1083 ((and (string-match "\\`[[:alnum:]]+\\'" name
) ; <mic> <root> <nobody>
1084 (equal (ffap-string-around) "<>")
1085 ;; (ffap-user-p name):
1086 (not (string-match "~" (expand-file-name (concat "~" name
))))
1088 (setq name
(concat "mailto:" name
)))
1090 (and (ffap-url-p name
) name
)
1093 (defvar ffap-gopher-regexp
1094 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
1095 "Regexp Matching a line in a gopher bookmark (maybe indented).
1096 The two subexpressions are the KEY and VALUE.")
1098 (defun ffap-gopher-at-point nil
1099 "If point is inside a gopher bookmark block, return its url."
1100 ;; `gopher-parse-bookmark' from gopher.el is not so robust
1103 (if (looking-at ffap-gopher-regexp
)
1105 (while (and (looking-at ffap-gopher-regexp
) (not (bobp)))
1107 (or (looking-at ffap-gopher-regexp
) (forward-line 1))
1108 (let ((type "1") name path host
(port "70"))
1109 (while (looking-at ffap-gopher-regexp
)
1112 (buffer-substring (match-beginning 1)
1114 (val (buffer-substring (match-beginning 2)
1118 (if (and path
(string-match "^ftp:.*@" path
))
1120 (substring path
4 (1- (match-end 0)))
1121 (substring path
(match-end 0)))
1122 (and (= (length type
) 1)
1123 host
;; (ffap-machine-p host)
1124 (concat "gopher://" host
1125 (if (equal port
"70") "" (concat ":" port
))
1126 "/" type path
))))))))
1128 (defvar ffap-ftp-sans-slash-regexp
1131 ;; Note: by now, we know it is not an url.
1132 ;; Icky regexp avoids: default: 123: foo::bar cs:pub
1133 ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
1134 "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
1135 "Strings matching this are coerced to ftp file names by ffap.
1136 That is, ffap just prepends \"/\". Set to nil to disable.")
1138 (defun ffap-file-at-point nil
1139 "Return filename from around point if it exists, or nil.
1140 Existence test is skipped for names that look remote.
1141 If the filename is not obvious, it also tries `ffap-alist',
1142 which may actually result in an url rather than a filename."
1143 ;; Note: this function does not need to look for url's, just
1144 ;; filenames. On the other hand, it is responsible for converting
1145 ;; a pseudo-url "site.com://dir" to an ftp file name
1146 (let* ((case-fold-search t
) ; url prefixes are case-insensitive
1148 (string (ffap-string-at-point)) ; uses mode alist
1150 (or (condition-case nil
1151 (and (not (string-match "//" string
)) ; foo.com://bar
1152 (substitute-in-file-name string
))
1155 (abs (file-name-absolute-p name
))
1156 (default-directory default-directory
)
1160 ;; Immediate rejects (/ and // and /* are too common in C/C++):
1161 ((member name
'("" "/" "//" "/*" ".")) nil
)
1162 ;; Immediately test local filenames. If default-directory is
1163 ;; remote, you probably already have a connection.
1164 ((and (not abs
) (ffap-file-exists-string name
)))
1165 ;; Try stripping off line numbers; good for compilation/grep output.
1166 ((and (not abs
) (string-match ":[0-9]" name
)
1167 (ffap-file-exists-string (substring name
0 (match-beginning 0)))))
1168 ;; Try stripping off prominent (non-root - #) shell prompts
1169 ;; if the ffap-shell-prompt-regexp is non-nil.
1170 ((and ffap-shell-prompt-regexp
1171 (not abs
) (string-match ffap-shell-prompt-regexp name
)
1172 (ffap-file-exists-string (substring name
(match-end 0)))))
1173 ;; Accept remote names without actual checking (too slow):
1174 ((and abs
(ffap-file-remote-p name
)))
1175 ;; Ok, not remote, try the existence test even if it is absolute:
1176 ((and abs
(ffap-file-exists-string name
)))
1177 ;; If it contains a colon, get rid of it (and return if exists)
1178 ((and (string-match path-separator name
)
1179 (setq name
(ffap-string-at-point 'nocolon
))
1180 (ffap-file-exists-string name
)))
1181 ;; File does not exist, try the alist:
1182 ((let ((alist ffap-alist
) tem try case-fold-search
)
1183 (while (and alist
(not try
))
1184 (setq tem
(car alist
) alist
(cdr alist
))
1185 (if (or (eq major-mode
(car tem
))
1186 (and (stringp (car tem
))
1187 (string-match (car tem
) name
)))
1190 (funcall (cdr tem
) name
)
1193 (ffap-url-p try
) ; not a file!
1194 (ffap-file-remote-p try
)
1195 (ffap-file-exists-string try
))))))
1197 ;; Try adding a leading "/" (common omission in ftp file names).
1198 ;; Note that this uses oname, which still has any colon part.
1199 ;; This should have a lower priority than the alist stuff,
1200 ;; else it matches things like "ffap.el:1234:56:Warning".
1202 ffap-ftp-sans-slash-regexp
1203 (string-match ffap-ftp-sans-slash-regexp oname
)
1204 (ffap-file-remote-p (concat "/" oname
))))
1205 ;; Alist failed? Try to guess an active remote connection
1206 ;; from buffer variables, and try once more, both as an
1207 ;; absolute and relative file name on that remote host.
1208 ((let* (ffap-rfs-regexp ; suppress
1211 ((ffap-file-remote-p default-directory
))
1212 ((and (eq major-mode
'internal-ange-ftp-mode
)
1213 (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$"
1215 (concat "/" (substring (buffer-name) 5 -
1) ":"))
1216 ;; This is too often a bad idea:
1217 ;;((and (eq major-mode 'w3-mode)
1218 ;; (stringp url-current-server))
1219 ;; (host-to-ange-path url-current-server))
1223 (and (string-match "\\`\\(/?~?ftp\\)/" name
)
1224 (ffap-file-exists-string
1225 (ffap-replace-file-component
1226 remote-dir
(substring name
(match-end 1)))))
1227 (ffap-file-exists-string
1228 (ffap-replace-file-component remote-dir name
))))))
1229 ((and ffap-dired-wildcards
1230 (string-match ffap-dired-wildcards name
)
1232 (ffap-file-exists-string (file-name-directory
1233 (directory-file-name name
)))
1235 ;; Try all parent directories by deleting the trailing directory
1236 ;; name until existing directory is found or name stops changing
1239 (not (ffap-file-exists-string dir
))
1240 (not (equal dir
(setq dir
(file-name-directory
1241 (directory-file-name dir
)))))))
1242 (ffap-file-exists-string dir
)))
1244 (set-match-data data
))))
1246 ;;; Prompting (`ffap-read-file-or-url'):
1248 ;; We want to complete filenames as in read-file-name, but also url's
1249 ;; which read-file-name-internal would truncate at the "//" string.
1250 ;; The solution here is to replace read-file-name-internal with
1251 ;; `ffap-read-file-or-url-internal', which checks the minibuffer
1252 ;; contents before attempting to complete filenames.
1254 (defun ffap-read-file-or-url (prompt guess
)
1255 "Read file or url from minibuffer, with PROMPT and initial GUESS."
1256 (or guess
(setq guess default-directory
))
1258 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
1259 ;; or "w3/" or "../el/ffap.el" or "../../../"
1260 (or (ffap-url-p guess
)
1262 (or (ffap-file-remote-p guess
)
1264 (abbreviate-file-name (expand-file-name guess
))
1266 (setq dir
(file-name-directory guess
))))
1267 (let ((minibuffer-completing-file-name t
)
1268 (completion-ignore-case read-file-name-completion-ignore-case
)
1269 (fnh-elem (cons ffap-url-regexp
'url-file-handler
)))
1270 ;; Explain to `rfn-eshadow' that we can use URLs here.
1271 (push fnh-elem file-name-handler-alist
)
1276 'ffap-read-file-or-url-internal
1279 (if dir
(cons guess
(length dir
)) guess
)
1280 (list 'file-name-history
)
1281 (and buffer-file-name
1282 (abbreviate-file-name buffer-file-name
))))
1283 ;; Remove the special handler manually. We used to just let-bind
1284 ;; file-name-handler-alist to preserve its value, but that caused
1285 ;; other modifications to be lost (e.g. when Tramp gets loaded
1286 ;; during the completing-read call).
1287 (setq file-name-handler-alist
(delq fnh-elem file-name-handler-alist
))))
1288 ;; Do file substitution like (interactive "F"), suggested by MCOOK.
1289 (or (ffap-url-p guess
) (setq guess
(substitute-in-file-name guess
)))
1290 ;; Should not do it on url's, where $ is a common (VMS?) character.
1291 ;; Note: upcoming url.el package ought to handle this automatically.
1294 (defun ffap-read-url-internal (string dir action
)
1295 "Complete url's from history, treating given string as valid."
1296 (let ((hist (ffap-soft-value "url-global-history-hash-table")))
1299 (or (try-completion string hist
) string
))
1301 (or (all-completions string hist
) (list string
)))
1302 ;; action == lambda, documented where? Tests whether string is a
1303 ;; valid "match". Let us always say yes.
1306 (defun ffap-read-file-or-url-internal (string dir action
)
1308 (setq dir default-directory
))
1310 (setq string default-directory
))
1311 (if (ffap-url-p string
)
1312 (ffap-read-url-internal string dir action
)
1313 (read-file-name-internal string dir action
)))
1315 ;; The rest of this page is just to work with package complete.el.
1316 ;; This code assumes that you load ffap.el after complete.el.
1318 ;; We must inform complete about whether our completion function
1319 ;; will do filename style completion.
1321 (defun ffap-complete-as-file-p nil
1322 ;; Will `minibuffer-completion-table' complete the minibuffer
1323 ;; contents as a filename? Assumes the minibuffer is current.
1324 ;; Note: t and non-nil mean somewhat different reasons.
1325 (if (eq minibuffer-completion-table
'ffap-read-file-or-url-internal
)
1326 (not (ffap-url-p (buffer-string))) ; t
1327 (and minibuffer-completing-file-name
'(t)))) ;list
1330 (featurep 'complete
)
1331 (if (boundp 'PC-completion-as-file-name-predicate
)
1332 ;; modern version of complete.el, just set the variable:
1333 (setq PC-completion-as-file-name-predicate
'ffap-complete-as-file-p
)))
1336 ;;; Highlighting (`ffap-highlight'):
1338 ;; Based on overlay highlighting in Emacs 19.28 isearch.el.
1340 (defvar ffap-highlight t
1341 "If non-nil, ffap highlights the current buffer substring.")
1344 '((t :inherit highlight
))
1345 "Face used to highlight the current buffer substring."
1349 (defvar ffap-highlight-overlay nil
1350 "Overlay used by `ffap-highlight'.")
1352 (defun ffap-highlight (&optional remove
)
1353 "If `ffap-highlight' is set, highlight the guess in this buffer.
1354 That is, the last buffer substring found by `ffap-string-at-point'.
1355 Optional argument REMOVE means to remove any such highlighting.
1356 Uses the face `ffap' if it is defined, or else `highlight'."
1359 (and ffap-highlight-overlay
1360 (delete-overlay ffap-highlight-overlay
))
1362 ((not ffap-highlight
) nil
)
1363 (ffap-highlight-overlay
1365 ffap-highlight-overlay
1366 (car ffap-string-at-point-region
)
1367 (nth 1 ffap-string-at-point-region
)
1370 (setq ffap-highlight-overlay
1371 (apply 'make-overlay ffap-string-at-point-region
))
1372 (overlay-put ffap-highlight-overlay
'face
'ffap
))))
1375 ;;; Main Entrance (`find-file-at-point' == `ffap'):
1377 (defun ffap-guesser nil
1378 "Return file or URL or nil, guessed from text around point."
1379 (or (and ffap-url-regexp
1380 (ffap-fixup-url (or (ffap-url-at-point)
1381 (ffap-gopher-at-point))))
1382 (ffap-file-at-point) ; may yield url!
1383 (ffap-fixup-machine (ffap-machine-at-point))))
1385 (defun ffap-prompter (&optional guess
)
1386 ;; Does guess and prompt step for find-file-at-point.
1387 ;; Extra complication for the temporary highlighting.
1389 ;; This catch will let ffap-alist entries do their own prompting
1390 ;; and then maybe skip over this prompt (ff-paths, for example).
1391 (catch 'ffap-prompter
1392 (ffap-read-file-or-url
1393 (if ffap-url-regexp
"Find file or URL: " "Find file: ")
1395 (setq guess
(or guess
(ffap-guesser))) ; using ffap-alist here
1396 (and guess
(ffap-highlight))
1398 (ffap-highlight t
)))
1401 (defun find-file-at-point (&optional filename
)
1402 "Find FILENAME, guessing a default from text around point.
1403 If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
1404 With a prefix, this command behaves exactly like `ffap-file-finder'.
1405 If `ffap-require-prefix' is set, the prefix meaning is reversed.
1406 See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
1407 and the functions `ffap-file-at-point' and `ffap-url-at-point'."
1409 (if (and (interactive-p)
1410 (if ffap-require-prefix
(not current-prefix-arg
)
1411 current-prefix-arg
))
1412 ;; Do exactly the ffap-file-finder command, even the prompting:
1413 (let (current-prefix-arg) ; we already interpreted it
1414 (call-interactively ffap-file-finder
))
1415 (or filename
(setq filename
(ffap-prompter)))
1417 ((ffap-url-p filename
)
1418 (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC
1419 (funcall ffap-url-fetcher filename
)))
1420 ((and ffap-pass-wildcards-to-dired
1421 ffap-dired-wildcards
1422 (string-match ffap-dired-wildcards filename
))
1423 (funcall ffap-directory-finder filename
))
1424 ((and ffap-dired-wildcards
1425 (string-match ffap-dired-wildcards filename
)
1427 ;; Check if it's find-file that supports wildcards arg
1428 (memq ffap-file-finder
'(find-file find-alternate-file
)))
1429 (funcall ffap-file-finder
(expand-file-name filename
) t
))
1430 ((or (not ffap-newfile-prompt
)
1431 (file-exists-p filename
)
1432 (y-or-n-p "File does not exist, create buffer? "))
1433 (funcall ffap-file-finder
1434 ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
1435 (expand-file-name filename
)))
1436 ;; User does not want to find a non-existent file:
1437 ((signal 'file-error
(list "Opening file buffer"
1438 "no such file or directory"
1441 ;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
1443 (defalias 'ffap
'find-file-at-point
)
1446 ;;; Menu support (`ffap-menu'):
1448 (defvar ffap-menu-regexp nil
1449 "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
1450 Make this more restrictive for faster menu building.
1451 For example, try \":/\" for URL (and some ftp) references.")
1453 (defvar ffap-menu-alist nil
1454 "Buffer local cache of menu presented by `ffap-menu'.")
1455 (make-variable-buffer-local 'ffap-menu-alist
)
1457 (defvar ffap-menu-text-plist
1459 ((display-mouse-p) '(face bold mouse-face highlight
)) ; keymap <mousy-map>
1461 "Text properties applied to strings found by `ffap-menu-rescan'.
1462 These properties may be used to fontify the menu references.")
1465 (defun ffap-menu (&optional rescan
)
1466 "Put up a menu of files and urls mentioned in this buffer.
1467 Then set mark, jump to choice, and try to fetch it. The menu is
1468 cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
1469 The optional RESCAN argument \(a prefix, interactively\) forces
1470 a rebuild. Searches with `ffap-menu-regexp'."
1472 ;; (require 'imenu) -- no longer used, but roughly emulated
1473 (if (or (not ffap-menu-alist
) rescan
1474 ;; or if the first entry is wrong:
1475 (and ffap-menu-alist
1476 (let ((first (car ffap-menu-alist
)))
1478 (goto-char (cdr first
))
1479 (not (equal (car first
) (ffap-guesser)))))))
1483 (if ffap-url-regexp
"Find file or URL" "Find file")
1484 (cons (cons "*Rescan Buffer*" -
1) ffap-menu-alist
)
1487 (defun ffap-menu-cont (choice) ; continuation of ffap-menu
1488 (if (< (cdr choice
) 0)
1489 (ffap-menu t
) ; *Rescan*
1491 (goto-char (cdr choice
))
1492 ;; Momentary highlight:
1495 (and ffap-highlight
(ffap-guesser) (ffap-highlight))
1496 (sit-for 0) ; display
1497 (find-file-at-point (car choice
)))
1498 (ffap-highlight t
))))
1500 (defun ffap-menu-ask (title alist cont
)
1501 "Prompt from a menu of choices, and then apply some action.
1502 Arguments are TITLE, ALIST, and CONT \(a continuation function\).
1503 This uses either a menu or the minibuffer depending on invocation.
1504 The TITLE string is used as either the prompt or menu title.
1505 Each ALIST entry looks like (STRING . DATA) and defines one choice.
1506 Function CONT is applied to the entry chosen by the user."
1507 ;; Note: this function is used with a different continuation
1508 ;; by the ffap-url add-on package.
1509 ;; Could try rewriting to use easymenu.el or lmenu.el.
1513 ((and (fboundp 'x-popup-menu
) (ffap-mouse-event))
1517 (list "" (cons title
1518 (mapcar (function (lambda (i) (cons (car i
) i
)))
1520 ;; minibuffer with completion buffer:
1522 (let ((minibuffer-setup-hook 'minibuffer-completion-help
))
1523 ;; Bug: prompting may assume unique strings, no "".
1526 (format "%s (default %s): " title
(car (car alist
)))
1528 ;; (cons (car (car alist)) 0)
1530 (sit-for 0) ; redraw original screen
1531 ;; Convert string to its entry, or else the default:
1532 (setq choice
(or (assoc choice alist
) (car alist
))))
1535 (funcall cont choice
)
1536 (message "No choice made!") ; possible with menus
1539 (defun ffap-menu-rescan nil
1540 "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
1541 Applies `ffap-menu-text-plist' text properties at all matches."
1543 (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp
))
1544 (range (- (point-max) (point-min)))
1545 (mod (buffer-modified-p)) ; was buffer modified?
1546 ;; inhibit-read-only works on read-only text properties
1547 ;; as well as read-only buffers.
1548 (inhibit-read-only t
) ; to set text-properties
1550 ;; Avoid repeated searches of the *mode-alist:
1551 (major-mode (if (assq major-mode ffap-string-at-point-mode-alist
)
1554 (setq ffap-menu-alist nil
)
1557 (goto-char (point-min))
1558 (while (setq item
(ffap-next-guess))
1559 (setq ffap-menu-alist
(cons (cons item
(point)) ffap-menu-alist
))
1560 (add-text-properties (car ffap-string-at-point-region
) (point)
1561 ffap-menu-text-plist
)
1562 (message "Scanning...%2d%% <%s>"
1563 (/ (* 100 (- (point) (point-min))) range
) item
)))
1564 (or mod
(set-buffer-modified-p nil
))))
1565 (message "Scanning...done")
1566 ;; Remove duplicates.
1567 (setq ffap-menu-alist
; sort by item
1568 (sort ffap-menu-alist
1570 (lambda (a b
) (string-lessp (car a
) (car b
))))))
1571 (let ((ptr ffap-menu-alist
)) ; remove duplicates
1573 (if (equal (car (car ptr
)) (car (car (cdr ptr
))))
1574 (setcdr ptr
(cdr (cdr ptr
)))
1575 (setq ptr
(cdr ptr
)))))
1576 (setq ffap-menu-alist
; sort by position
1577 (sort ffap-menu-alist
1579 (lambda (a b
) (< (cdr a
) (cdr b
)))))))
1582 ;;; Mouse Support (`ffap-at-mouse'):
1584 ;; See the suggested binding in ffap-bindings (near eof).
1586 (defvar ffap-at-mouse-fallback nil
; ffap-menu? too time-consuming
1587 "Command invoked by `ffap-at-mouse' if nothing found at click, or nil.
1588 Ignored when `ffap-at-mouse' is called programmatically.")
1589 (put 'ffap-at-mouse-fallback
'risky-local-variable t
)
1592 (defun ffap-at-mouse (e)
1593 "Find file or url guessed from text around mouse click.
1594 Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
1596 * if a guess string is found, return it (after finding it)
1597 * if the fallback is called, return whatever it returns
1601 ;; Maybe less surprising without the save-excursion?
1604 ;; Would prefer to do nothing unless click was *on* text. How
1605 ;; to tell that the click was beyond the end of current line?
1609 (set-buffer (ffap-event-buffer e
))
1613 (sit-for 0) ; display
1614 (message "Finding `%s'" guess
)
1615 (find-file-at-point guess
)
1616 guess
) ; success: return non-nil
1617 (ffap-highlight t
)))
1619 (if ffap-at-mouse-fallback
1620 (call-interactively ffap-at-mouse-fallback
)
1621 (message "No file or url found at mouse click.")
1622 nil
)) ; no fallback, return nil
1623 ;; failure: return nil
1627 ;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands:
1629 ;; There could be a real `ffap-noselect' function, but we would need
1630 ;; at least two new user variables, and there is no w3-fetch-noselect.
1631 ;; So instead, we just fake it with a slow save-window-excursion.
1633 (defun ffap-other-window nil
1634 "Like `ffap', but put buffer in another window.
1635 Only intended for interactive use."
1638 (switch-to-buffer-other-window
1639 (save-window-excursion
1640 (setq value
(call-interactively 'ffap
))
1641 (unless (or (bufferp value
) (bufferp (car-safe value
)))
1642 (setq value
(current-buffer)))
1646 (defun ffap-other-frame nil
1647 "Like `ffap', but put buffer in another frame.
1648 Only intended for interactive use."
1650 ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1651 (let* ((win (selected-window))
1652 (wdp (window-dedicated-p win
))
1656 (set-window-dedicated-p win nil
)
1657 (switch-to-buffer-other-frame
1658 (save-window-excursion
1659 (setq value
(call-interactively 'ffap
))
1660 (unless (or (bufferp value
) (bufferp (car-safe value
)))
1661 (setq value
(current-buffer)))
1663 (set-window-dedicated-p win wdp
))
1666 (defun ffap-read-only ()
1667 "Like `ffap', but mark buffer as read-only.
1668 Only intended for interactive use."
1670 (let ((value (call-interactively 'ffap
)))
1671 (unless (or (bufferp value
) (bufferp (car-safe value
)))
1672 (setq value
(current-buffer)))
1673 (mapc (lambda (b) (with-current-buffer b
(toggle-read-only 1)))
1674 (if (listp value
) value
(list value
)))
1677 (defun ffap-read-only-other-window ()
1678 "Like `ffap', but put buffer in another window and mark as read-only.
1679 Only intended for interactive use."
1681 (let ((value (ffap-other-window)))
1682 (mapc (lambda (b) (with-current-buffer b
(toggle-read-only 1)))
1683 (if (listp value
) value
(list value
)))
1686 (defun ffap-read-only-other-frame ()
1687 "Like `ffap', but put buffer in another frame and mark as read-only.
1688 Only intended for interactive use."
1690 (let ((value (ffap-other-frame)))
1691 (mapc (lambda (b) (with-current-buffer b
(toggle-read-only 1)))
1692 (if (listp value
) value
(list value
)))
1695 (defun ffap-alternate-file ()
1696 "Like `ffap' and `find-alternate-file'.
1697 Only intended for interactive use."
1699 (let ((ffap-file-finder 'find-alternate-file
))
1700 (call-interactively 'ffap
)))
1705 (define-obsolete-function-alias 'ffap-bug
'report-emacs-bug
"23.1")
1706 (define-obsolete-function-alias 'ffap-submit-bug
'report-emacs-bug
"23.1")
1709 ;;; Hooks for Gnus, VM, Rmail:
1711 ;; If you do not like these bindings, write versions with whatever
1712 ;; bindings you would prefer.
1714 (defun ffap-ro-mode-hook nil
1715 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
1716 (local-set-key "\M-l" 'ffap-next
)
1717 (local-set-key "\M-m" 'ffap-menu
)
1720 (defun ffap-gnus-hook nil
1721 "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
1722 (set (make-local-variable 'ffap-foo-at-bar-prefix
) "news") ; message-id's
1723 ;; Note "l", "L", "m", "M" are taken:
1724 (local-set-key "\M-l" 'ffap-gnus-next
)
1725 (local-set-key "\M-m" 'ffap-gnus-menu
))
1727 (defvar gnus-summary-buffer
)
1728 (defvar gnus-article-buffer
)
1730 ;; This code is called from gnus.
1731 (declare-function gnus-summary-select-article
"gnus-sum"
1732 (&optional all-headers force pseudo article
))
1734 (declare-function gnus-configure-windows
"gnus-win"
1735 (setting &optional force
))
1737 (defun ffap-gnus-wrapper (form) ; used by both commands below
1738 (and (eq (current-buffer) (get-buffer gnus-summary-buffer
))
1739 (gnus-summary-select-article)) ; get article of current line
1740 ;; Preserve selected buffer, but do not do save-window-excursion,
1741 ;; since we want to see any window created by the form. Temporarily
1742 ;; select the article buffer, so we can see any point movement.
1743 (let ((sb (window-buffer (selected-window))))
1744 (gnus-configure-windows 'article
)
1745 (pop-to-buffer gnus-article-buffer
)
1747 ;; Skip headers for ffap-gnus-next (which will wrap around)
1748 (if (eq (point) (point-min)) (search-forward "\n\n" nil t
))
1751 (pop-to-buffer sb
))))
1753 (defun ffap-gnus-next nil
1754 "Run `ffap-next' in the gnus article buffer."
1755 (interactive) (ffap-gnus-wrapper '(ffap-next nil t
)))
1757 (defun ffap-gnus-menu nil
1758 "Run `ffap-menu' in the gnus article buffer."
1759 (interactive) (ffap-gnus-wrapper '(ffap-menu)))
1762 (defcustom dired-at-point-require-prefix nil
1763 "*If set, reverses the prefix argument to `dired-at-point'.
1764 This is nil so neophytes notice ffap. Experts may prefer to disable
1765 ffap most of the time."
1771 (defun dired-at-point (&optional filename
)
1772 "Start Dired, defaulting to file at point. See `ffap'."
1774 (if (and (interactive-p)
1775 (if dired-at-point-require-prefix
1776 (not current-prefix-arg
)
1777 current-prefix-arg
))
1778 (let (current-prefix-arg) ; already interpreted
1779 (call-interactively ffap-directory-finder
))
1780 (or filename
(setq filename
(dired-at-point-prompter)))
1782 ((ffap-url-p filename
)
1783 (funcall ffap-url-fetcher filename
))
1784 ((and ffap-dired-wildcards
1785 (string-match ffap-dired-wildcards filename
))
1786 (funcall ffap-directory-finder filename
))
1787 ((file-exists-p filename
)
1788 (if (file-directory-p filename
)
1789 (funcall ffap-directory-finder
1790 (expand-file-name filename
))
1791 (funcall ffap-directory-finder
1792 (concat (expand-file-name filename
) "*"))))
1793 ((and (file-writable-p
1794 (or (file-name-directory (directory-file-name filename
))
1796 (y-or-n-p "Directory does not exist, create it? "))
1797 (make-directory filename
)
1798 (funcall ffap-directory-finder filename
))
1799 ((error "No such file or directory `%s'" filename
)))))
1801 (defun dired-at-point-prompter (&optional guess
)
1802 ;; Does guess and prompt step for find-file-at-point.
1803 ;; Extra complication for the temporary highlighting.
1805 (ffap-read-file-or-url
1807 ((eq ffap-directory-finder
'list-directory
)
1808 "List directory (brief): ")
1809 (ffap-url-regexp "Dired file or URL: ")
1812 (setq guess
(or guess
1813 (let ((guess (ffap-guesser)))
1816 (ffap-file-remote-p guess
))
1818 (setq guess
(abbreviate-file-name
1819 (expand-file-name guess
)))
1821 ;; Interpret local directory as a directory.
1822 ((file-directory-p guess
)
1823 (file-name-as-directory guess
))
1824 ;; Get directory component from local files.
1825 ((file-regular-p guess
)
1826 (file-name-directory guess
))
1829 (and guess
(ffap-highlight))))
1830 (ffap-highlight t
)))
1832 ;;; ffap-dired-other-*, ffap-list-directory commands:
1834 (defun ffap-dired-other-window ()
1835 "Like `dired-at-point', but put buffer in another window.
1836 Only intended for interactive use."
1839 (switch-to-buffer-other-window
1840 (save-window-excursion
1841 (setq value
(call-interactively 'dired-at-point
))
1845 (defun ffap-dired-other-frame ()
1846 "Like `dired-at-point', but put buffer in another frame.
1847 Only intended for interactive use."
1849 ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1850 (let* ((win (selected-window))
1851 (wdp (window-dedicated-p win
))
1855 (set-window-dedicated-p win nil
)
1856 (switch-to-buffer-other-frame
1857 (save-window-excursion
1858 (setq value
(call-interactively 'dired-at-point
))
1860 (set-window-dedicated-p win wdp
))
1863 (defun ffap-list-directory ()
1864 "Like `dired-at-point' and `list-directory'.
1865 Only intended for interactive use."
1867 (let ((ffap-directory-finder 'list-directory
))
1868 (call-interactively 'dired-at-point
)))
1871 ;;; Offer default global bindings (`ffap-bindings'):
1873 (defvar ffap-bindings
1875 (global-set-key [S-mouse-3
] 'ffap-at-mouse
)
1876 (global-set-key [C-S-mouse-3
] 'ffap-menu
)
1878 (global-set-key "\C-x\C-f" 'find-file-at-point
)
1879 (global-set-key "\C-x\C-r" 'ffap-read-only
)
1880 (global-set-key "\C-x\C-v" 'ffap-alternate-file
)
1882 (global-set-key "\C-x4f" 'ffap-other-window
)
1883 (global-set-key "\C-x5f" 'ffap-other-frame
)
1884 (global-set-key "\C-x4r" 'ffap-read-only-other-window
)
1885 (global-set-key "\C-x5r" 'ffap-read-only-other-frame
)
1887 (global-set-key "\C-xd" 'dired-at-point
)
1888 (global-set-key "\C-x4d" 'ffap-dired-other-window
)
1889 (global-set-key "\C-x5d" 'ffap-dired-other-frame
)
1890 (global-set-key "\C-x\C-d" 'ffap-list-directory
)
1892 (add-hook 'gnus-summary-mode-hook
'ffap-gnus-hook
)
1893 (add-hook 'gnus-article-mode-hook
'ffap-gnus-hook
)
1894 (add-hook 'vm-mode-hook
'ffap-ro-mode-hook
)
1895 (add-hook 'rmail-mode-hook
'ffap-ro-mode-hook
)
1896 ;; (setq dired-x-hands-off-my-keys t) ; the default
1898 "List of binding forms evaluated by function `ffap-bindings'.
1899 A reasonable ffap installation needs just this one line:
1901 Of course if you do not like these bindings, just roll your own!")
1904 (defun ffap-bindings nil
1905 "Evaluate the forms in variable `ffap-bindings'."
1907 (eval (cons 'progn ffap-bindings
)))
1911 ;;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc
1912 ;;; ffap.el ends here