1 ;;; ffap.el --- find file (or url) at point
3 ;; Copyright (C) 1995-1997, 2000-2017 Free Software Foundation, Inc.
5 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
6 ;; Maintainer: emacs-devel@gnu.org
7 ;; Created: 29 Mar 1993
8 ;; Keywords: files, hypermedia, matching, mouse, convenience
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 3 of the License, or
15 ;; (at your option) any later version.
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. If not, see <https://www.gnu.org/licenses/>.
28 ;; Command find-file-at-point replaces find-file. With a prefix, it
29 ;; behaves exactly like find-file. Without a prefix, it first tries
30 ;; to guess a default file or URL from the text around the point
31 ;; (`ffap-require-prefix' swaps these behaviors). This is useful for
32 ;; following references in situations such as mail or news buffers,
33 ;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
34 ;; M-x report-emacs-bug.
36 ;; For the default installation, add this line to your init file:
38 ;; (ffap-bindings) ; do default key bindings
40 ;; ffap-bindings makes the following global key bindings:
42 ;; C-x C-f find-file-at-point (abbreviated as ffap)
43 ;; C-x C-r ffap-read-only
44 ;; C-x C-v ffap-alternate-file
46 ;; C-x d dired-at-point
47 ;; C-x C-d ffap-list-directory
49 ;; C-x 4 f ffap-other-window
50 ;; C-x 4 r ffap-read-only-other-window
51 ;; C-x 4 d ffap-dired-other-window
53 ;; C-x 5 f ffap-other-frame
54 ;; C-x 5 r ffap-read-only-other-frame
55 ;; C-x 5 d ffap-dired-other-frame
57 ;; S-mouse-3 ffap-at-mouse
58 ;; C-S-mouse-3 ffap-menu
60 ;; ffap-bindings also adds hooks to make the following local bindings
61 ;; in vm, gnus, and rmail:
63 ;; M-l ffap-next, or ffap-gnus-next in gnus (l == "link")
64 ;; M-m ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
66 ;; If you do not like these bindings, modify the variable
67 ;; `ffap-bindings', or write your own.
69 ;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
70 ;; to load or autoload them before ffap. If you use ff-paths, load it
71 ;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many
72 ;; option variables. In particular, if ffap is slow, try these:
74 ;; (setq ffap-alist nil) ; faster, dumber prompting
75 ;; (setq ffap-machine-p-known 'accept) ; no pinging
76 ;; (setq ffap-url-regexp nil) ; disable URL features in ffap
77 ;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping
78 ;; (setq ffap-gopher-regexp nil) ; disable gopher bookmark matching
80 ;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
81 ;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
82 ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
83 ;; the file and URL references within a buffer.
88 ;; The History and Contributors moved to ffap.LOG (same ftp site),
89 ;; which also has some old examples and commentary from ffap 1.5.
93 ;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file
94 ;; * find file of symbol if TAGS is loaded (like above)
95 ;; * break long menus into multiple panes (like imenu?)
96 ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
97 ;; * notice "machine.dom blah blah blah dir/file" (how?)
98 ;; * as w3 becomes standard, rewrite to rely more on its functions
99 ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
100 ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
101 ;; * handle "$(VAR)" in Makefiles
102 ;; * use the font-lock machinery
110 (define-obsolete-variable-alias 'ffap-version
'emacs-version
"23.2")
113 "Find file or URL at point."
115 ;; :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/")
119 ;; The code is organized in pages, separated by formfeed characters.
120 ;; See the next two pages for standard customization ideas.
125 (defun ffap-symbol-value (sym &optional default
)
126 "Return value of symbol SYM, if bound, or DEFAULT otherwise."
127 (if (boundp sym
) (symbol-value sym
) default
))
129 (defcustom ffap-shell-prompt-regexp
130 ;; This used to test for some shell prompts that don't have a space
131 ;; after them. The common root shell prompt (#) is not listed since it
132 ;; also doubles up as a valid URL character.
134 "Paths matching this regexp are stripped off the shell prompt.
135 If nil, ffap doesn't do shell prompt stripping."
136 :type
'(choice (const :tag
"Disable" nil
)
137 (const :tag
"Standard" "[$%><]*")
141 (defcustom ffap-ftp-regexp
"\\`/[^/:]+:"
142 "File names matching this regexp are treated as remote ffap.
143 If nil, ffap neither recognizes nor generates such names."
144 :type
'(choice (const :tag
"Disable" nil
)
145 (const :tag
"Standard" "\\`/[^/:]+:")
149 (defcustom ffap-url-unwrap-local t
150 "If non-nil, convert some URLs to local file names before prompting.
151 Only \"file:\" and \"ftp:\" URLs are converted, and only if they
152 do not specify a host, or the host is either \"localhost\" or
153 equal to `system-name'."
157 (defcustom ffap-url-unwrap-remote
'("ftp")
158 "If non-nil, convert URLs to remote file names before prompting.
159 If the value is a list of strings, that specifies a list of URL
160 schemes (e.g. \"ftp\"); in that case, only convert those URLs."
161 :type
'(choice (repeat string
) boolean
)
165 (defcustom ffap-lax-url t
166 "If non-nil, allow lax URL matching.
167 The default non-nil value might produce false URLs in C++ code
168 with symbols like \"std::find\". On the other hand, setting
169 this to nil will disable recognition of URLs that are not
170 well-formed, such as \"user@host\" or \"<user@host>\"."
173 :version
"25.2") ; nil -> t
175 (defcustom ffap-ftp-default-user
"anonymous"
176 "User name in FTP file names generated by `ffap-host-to-path'.
177 Note this name may be omitted if it equals the default
178 \(either `efs-default-user' or `ange-ftp-default-user')."
182 (defcustom ffap-rfs-regexp
183 ;; Remote file access built into file system? HP rfa or Andrew afs:
184 "\\`/\\(afs\\|net\\)/."
185 ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
186 "Matching file names are treated as remote. Use nil to disable."
190 (defvar ffap-url-regexp
193 "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
195 "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
197 "Regexp matching the beginning of a URI, for ffap.
198 If the value is nil, disable URL-matching features in ffap.")
200 (defcustom ffap-foo-at-bar-prefix
"mailto"
201 "Presumed URL prefix type of strings like \"<foo.9z@bar>\".
202 Sensible values are nil, \"news\", or \"mailto\"."
203 :type
'(choice (const "mailto")
205 (const :tag
"Disable" nil
)
206 ;; string -- possible, but not really useful
210 (defvar ffap-max-region-length
1024
211 "Maximum active region length.
212 When the region is active and larger than this value,
213 `ffap-string-at-point' returns an empty string.")
216 ;;; Peanut Gallery (More User Variables):
218 ;; Users of ffap occasionally suggest new features. If I consider
219 ;; those features interesting but not clear winners (a matter of
220 ;; personal taste) I try to leave options to enable them. Read
221 ;; through this section for features that you like, put an appropriate
222 ;; enabler in your init file.
224 (defcustom ffap-dired-wildcards
"[*?][^/]*\\'"
225 "A regexp matching filename wildcard characters, or nil.
227 If `find-file-at-point' gets a filename matching this pattern,
228 and `ffap-pass-wildcards-to-dired' is nil, it passes it on to
229 `find-file' with non-nil WILDCARDS argument, which expands
230 wildcards and visits multiple files. To visit a file whose name
231 contains wildcard characters you can suppress wildcard expansion
232 by setting `find-file-wildcards'. If `find-file-at-point' gets a
233 filename matching this pattern and `ffap-pass-wildcards-to-dired'
234 is non-nil, it passes it on to `dired'.
236 If `dired-at-point' gets a filename matching this pattern,
237 it passes it on to `dired'."
238 :type
'(choice (const :tag
"Disable" nil
)
239 (const :tag
"Enable" "[*?][^/]*\\'")
240 ;; regexp -- probably not useful
244 (defcustom ffap-pass-wildcards-to-dired nil
245 "If non-nil, pass filenames matching `ffap-dired-wildcards' to Dired."
249 (defcustom ffap-newfile-prompt nil
250 ;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is
251 ;; better handled by `find-file-not-found-hooks'.
252 "Whether `find-file-at-point' prompts about a nonexistent file."
256 (defcustom ffap-require-prefix nil
257 ;; Suggestion from RHOGEE, 20 Oct 1994.
258 "If set, reverses the prefix argument to `find-file-at-point'.
259 This is nil so neophytes notice ffap. Experts may prefer to disable
260 ffap most of the time."
264 (defcustom ffap-file-finder
'find-file
265 "The command called by `find-file-at-point' to find a file."
270 (defcustom ffap-directory-finder
'dired
271 "The command called by `dired-at-point' to find a directory."
276 (defcustom ffap-url-fetcher
'browse-url
277 "A function of one argument, called by ffap to fetch an URL.
278 For a fancy alternative, get `ffap-url.el'."
279 :type
'(choice (const browse-url
)
284 (defcustom ffap-next-regexp
285 ;; If you want ffap-next to find URL's only, try this:
286 ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
287 ;; (concat "\\<" (substring ffap-url-regexp 2))))
289 ;; It pays to put a big fancy regexp here, since ffap-guesser is
290 ;; much more time-consuming than regexp searching:
291 "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
292 "Regular expression governing movements of `ffap-next'."
296 (defcustom dired-at-point-require-prefix nil
297 "If non-nil, reverse the prefix argument to `dired-at-point'.
298 This is nil so neophytes notice ffap. Experts may prefer to
299 disable ffap most of the time."
307 ;; This version of ffap supports only the Emacs it is distributed in.
308 ;; See the ftp site for a more general version. The following
309 ;; functions are necessary "leftovers" from the more general version.
311 (defun ffap-mouse-event () ; current mouse event, or nil
312 (and (listp last-nonmenu-event
) last-nonmenu-event
))
313 (defun ffap-event-buffer (event)
314 (window-buffer (car (event-start event
))))
317 ;;; Find Next Thing in buffer (`ffap-next'):
319 ;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
320 ;; then, broke it up into ffap-next-guess (noninteractive) and
321 ;; ffap-next (a command). It now work on files as well as url's.
323 (defvar ffap-next-guess nil
324 "Last value returned by `ffap-next-guess'.")
326 (defvar ffap-string-at-point-region
'(1 1)
327 "List (BEG END), last region returned by the function `ffap-string-at-point'.")
329 (defun ffap-next-guess (&optional back lim
)
330 "Move point to next file or URL, and return it as a string.
331 If nothing is found, leave point at limit and return nil.
332 Optional BACK argument makes search backwards.
333 Optional LIM argument limits the search.
334 Only considers strings that match `ffap-next-regexp'."
335 (or lim
(setq lim
(if back
(point-min) (point-max))))
337 (while (not (or guess
(eq (point) lim
)))
338 (funcall (if back
're-search-backward
're-search-forward
)
339 ffap-next-regexp lim
'move
)
340 (setq guess
(ffap-guesser)))
341 ;; Go to end, so we do not get same guess twice:
342 (goto-char (nth (if back
0 1) ffap-string-at-point-region
))
343 (setq ffap-next-guess guess
)))
346 (defun ffap-next (&optional back wrap
)
347 "Search buffer for next file or URL, and run ffap.
348 Optional argument BACK says to search backwards.
349 Optional argument WRAP says to try wrapping around if necessary.
350 Interactively: use a single prefix \\[universal-argument] to search backwards,
351 double prefix to wrap forward, triple to wrap backwards.
352 Actual search is done by the function `ffap-next-guess'."
354 (cdr (assq (prefix-numeric-value current-prefix-arg
)
355 '((1) (4 t
) (16 nil t
) (64 t t
)))))
357 (guess (ffap-next-guess back
)))
358 ;; Try wraparound if necessary:
359 (and (not guess
) wrap
360 (goto-char (if back
(point-max) (point-min)))
361 (setq guess
(ffap-next-guess back pt
)))
364 (sit-for 0) ; display point movement
365 (find-file-at-point (ffap-prompter guess
)))
366 (goto-char pt
) ; restore point
367 (message "No %sfiles or URL's found"
368 (if wrap
"" "more ")))))
370 (defun ffap-next-url (&optional back wrap
)
371 "Like `ffap-next', but search with `ffap-url-regexp'."
373 (let ((ffap-next-regexp ffap-url-regexp
))
374 (if (called-interactively-p 'interactive
)
375 (call-interactively 'ffap-next
)
376 (ffap-next back wrap
))))
379 ;;; Machines (`ffap-machine-p'):
381 ;; I cannot decide a "best" strategy here, so these are variables. In
382 ;; particular, if `Pinging...' is broken or takes too long on your
383 ;; machine, try setting these all to accept or reject.
384 (defcustom ffap-machine-p-local
'reject
; this happens often
385 "What `ffap-machine-p' does with hostnames that have no domain.
386 Value should be a symbol, one of `ping', `accept', and `reject'."
387 :type
'(choice (const ping
)
391 (defcustom ffap-machine-p-known
'ping
; `accept' for higher speed
392 "What `ffap-machine-p' does with hostnames that have a known domain.
393 Value should be a symbol, one of `ping', `accept', and `reject'.
394 See `mail-extr.el' for the known domains."
395 :type
'(choice (const ping
)
399 (defcustom ffap-machine-p-unknown
'reject
400 "What `ffap-machine-p' does with hostnames that have an unknown domain.
401 Value should be a symbol, one of `ping', `accept', and `reject'.
402 See `mail-extr.el' for the known domains."
403 :type
'(choice (const ping
)
408 (defun ffap-what-domain (domain)
409 ;; Like what-domain in mail-extr.el, returns string or nil.
411 (let ((ob (or (ffap-symbol-value 'mail-extr-all-top-level-domains
)
412 (ffap-symbol-value 'all-top-level-domains
)))) ; XEmacs
413 (and ob
(get (intern-soft (downcase domain
) ob
) 'domain-name
))))
415 (defun ffap-machine-p (host &optional service quiet strategy
)
416 "Decide whether HOST is the name of a real, reachable machine.
417 Depending on the domain (none, known, or unknown), follow the strategy
418 named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
419 or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
420 Optional SERVICE specifies the port used (default \"discard\").
421 Optional QUIET flag suppresses the \"Pinging...\" message.
422 Optional STRATEGY overrides the three variables above.
424 t means that HOST answered.
425 `accept' means the relevant variable told us to accept.
426 \"mesg\" means HOST exists, but does not respond for some reason."
427 ;; Try some (Emory local):
428 ;; (ffap-machine-p "ftp" nil nil 'ping)
429 ;; (ffap-machine-p "nonesuch" nil nil 'ping)
430 ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
431 ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
432 ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
433 ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
434 (if (or (string-match "[^-[:alnum:].]" host
) ; Invalid chars (?)
435 (not (string-match "[^0-9]" host
))) ; 1: a number? 2: quick reject
438 (and (string-match "\\.[^.]*$" host
)
439 (downcase (substring host
(1+ (match-beginning 0))))))
440 (what-domain (if domain
(ffap-what-domain domain
) "Local")))
443 (cond ((not domain
) ffap-machine-p-local
)
444 ((not what-domain
) ffap-machine-p-unknown
)
445 (t ffap-machine-p-known
))))
447 ((eq strategy
'accept
) 'accept
)
448 ((eq strategy
'reject
) nil
)
449 ((not (fboundp 'open-network-stream
)) nil
)
450 ;; assume (eq strategy 'ping)
453 (if (stringp what-domain
)
454 (message "Pinging %s (%s)..." host what-domain
)
455 (message "Pinging %s ..." host
)))
456 (condition-case error
460 "ffap-machine-p" nil host
(or service
"discard")))
463 (let ((mesg (car (cdr error
))))
466 ((string-match "\\(^Unknown host\\|Name or service not known$\\)"
468 ((string-match "not responding$" mesg
) mesg
)
470 ;; (file-error "connection failed" "permission denied"
471 ;; "nonesuch" "ffap-machine-p")
472 ;; (file-error "connection failed" "host is unreachable"
473 ;; "gopher.house.gov" "ffap-machine-p")
474 ;; (file-error "connection failed" "address already in use"
475 ;; "ftp.uu.net" "ffap-machine-p")
476 ((equal mesg
"connection failed")
477 (if (string= (downcase (nth 2 error
)) "permission denied")
478 nil
; host does not exist
479 ;; Other errors mean the host exists:
481 ;; Could be "Unknown service":
482 (t (signal (car error
) (cdr error
))))))))))))
485 ;;; Possibly Remote Resources:
487 (defun ffap-replace-file-component (fullname name
)
488 "In remote FULLNAME, replace path with NAME. May return nil."
489 ;; Use efs if loaded, but do not load it otherwise.
490 (if (fboundp 'efs-replace-path-component
)
491 (funcall 'efs-replace-path-component fullname name
)
492 (and (stringp fullname
)
494 (concat (file-remote-p 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 dying
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 ()
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-symbol-value 'ange-ftp-default-user
))
560 (equal user
(ffap-symbol-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 (defvaralias 'ffap-newsgroup-regexp
'thing-at-point-newsgroup-regexp
)
579 (defvaralias 'ffap-newsgroup-heads
'thing-at-point-newsgroup-heads
)
580 (defalias 'ffap-newsgroup-p
'thing-at-point-newsgroup-p
)
582 (defun ffap-url-p (string)
583 "If STRING looks like an URL, return it (maybe improved), else nil."
584 (when (and (stringp string
) ffap-url-regexp
)
585 (let* ((case-fold-search t
)
586 (match (string-match ffap-url-regexp string
)))
587 (cond ((eq match
0) string
)
588 (match (substring string match
))))))
590 ;; Broke these out of ffap-fixup-url, for use of ffap-url package.
591 (defun ffap-url-unwrap-local (url)
592 "Return URL as a local file name, or nil."
593 (let* ((obj (url-generic-parse-url url
))
594 (host (url-host obj
))
595 (filename (car (url-path-and-query obj
))))
596 (when (and (member (url-type obj
) '("ftp" "file"))
597 (member host
`("" "localhost" ,(system-name))))
598 ;; On Windows, "file:///C:/foo" should unwrap to "C:/foo"
599 (if (and (memq system-type
'(ms-dos windows-nt cygwin
))
600 (string-match "\\`/[a-zA-Z]:" filename
))
601 (substring filename
1)
604 (defun ffap-url-unwrap-remote (url)
605 "Return URL as a remote file name, or nil."
606 (let* ((obj (url-generic-parse-url url
))
607 (scheme (url-type obj
))
608 (valid-schemes (if (listp ffap-url-unwrap-remote
)
609 ffap-url-unwrap-remote
611 (host (url-host obj
))
612 (port (url-port-if-non-default obj
))
613 (user (url-user obj
))
614 (filename (car (url-path-and-query obj
))))
615 (when (and (member scheme valid-schemes
)
616 (string-match "\\`[a-zA-Z][-a-zA-Z0-9+.]*\\'" scheme
)
617 (not (equal host
"")))
618 (concat "/" scheme
":"
619 (if user
(concat user
"@"))
621 (if port
(concat "#" (number-to-string port
)))
624 (defun ffap-fixup-url (url)
625 "Clean up URL and return it, maybe as a file name."
627 ((not (stringp url
)) nil
)
628 ((and ffap-url-unwrap-local
(ffap-url-unwrap-local url
)))
629 ((and ffap-url-unwrap-remote
(ffap-url-unwrap-remote url
)))
633 ;;; File Name Handling:
635 ;; The upcoming ffap-alist actions need various utilities to prepare
636 ;; and search directories. Too many features here.
638 ;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
639 ;; (defun ffap-splice (func inlist)
640 ;; "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
641 ;; (let* ((head (cons 17 nil)) (last head))
643 ;; (setcdr last (funcall func (car inlist)))
644 ;; (setq last (ffap-last last) inlist (cdr inlist)))
647 (defun ffap-list-env (env &optional empty
)
648 "Return a list of strings parsed from environment variable ENV.
649 Optional EMPTY is the default list if (getenv ENV) is undefined, and
650 also is substituted for the first empty-string component, if there is one.
651 Uses `path-separator' to separate the path into substrings."
652 ;; We cannot use parse-colon-path (files.el), since it kills
653 ;; "//" entries using file-name-as-directory.
654 ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
655 ;; in ff-paths and bib-cite. The EMPTY arg may help mimic kpathsea.
656 (if (or empty
(getenv env
)) ; should return something
657 (let ((start 0) match dir ret
)
658 (setq env
(concat (getenv env
) path-separator
))
659 (while (setq match
(string-match path-separator env start
))
660 (setq dir
(substring env start match
) start
(1+ match
))
661 ;;(and (file-directory-p dir) (not (member dir ret)) ...)
662 (setq ret
(cons dir ret
)))
663 (setq ret
(nreverse ret
))
664 (and empty
(setq match
(member "" ret
))
665 (progn ; allow string or list here
666 (setcdr match
(append (cdr-safe empty
) (cdr match
)))
667 (setcar match
(or (car-safe empty
) empty
))))
670 (defun ffap-reduce-path (path)
671 "Remove duplicates and non-directories from PATH list."
674 (setq tem path path
(cdr path
))
675 (if (equal (car tem
) ".") (setcar tem
""))
676 (or (member (car tem
) ret
)
677 (not (file-directory-p (car tem
)))
678 (progn (setcdr tem ret
) (setq ret tem
))))
681 (defun ffap-all-subdirs (dir &optional depth
)
682 "Return list of all subdirectories under DIR, starting with itself.
683 Directories beginning with \".\" are ignored, and directory symlinks
684 are listed but never searched (to avoid loops).
685 Optional DEPTH limits search depth."
686 (and (file-exists-p dir
)
687 (ffap-all-subdirs-loop (expand-file-name dir
) (or depth -
1))))
689 (defun ffap-all-subdirs-loop (dir depth
) ; internal
690 (setq depth
(1- depth
))
692 (and (not (eq depth -
1))
698 ((not (file-directory-p d
)) nil
)
699 ((file-symlink-p d
) (list d
))
700 (t (ffap-all-subdirs-loop d depth
)))))
701 (directory-files dir t
"\\`[^.]")
704 (defvar ffap-kpathsea-depth
1
705 "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
706 Set to 0 to avoid all searching, or nil for no limit.")
708 (defun ffap-kpathsea-expand-path (path)
709 "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs.
710 The subdirs begin with the original directory, and the depth of the
711 search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
712 kpathsea, a library used by some versions of TeX."
717 (if (string-match "[^/]//\\'" dir
)
718 (ffap-all-subdirs (substring dir
0 -
2) ffap-kpathsea-depth
)
722 (defun ffap-locate-file (file nosuffix path
)
723 ;; The current version of locate-library could almost replace this,
724 ;; except it does not let us override the suffix list. The
725 ;; compression-suffixes search moved to ffap-file-exists-string.
726 "A generic path-searching function.
727 Returns the name of file in PATH, or nil.
728 Optional NOSUFFIX, if nil or t, is like the fourth argument
729 for `load': whether to try the suffixes (\".elc\" \".el\" \"\").
730 If a nonempty list, it is a list of suffixes to try instead.
731 PATH is a list of directories.
733 This uses `ffap-file-exists-string', which may try adding suffixes from
734 `ffap-compression-suffixes'."
735 (if (file-name-absolute-p file
)
736 (setq path
(list (file-name-directory file
))
737 file
(file-name-nondirectory file
)))
738 (let ((dir-ok (equal "" (file-name-nondirectory file
)))
741 ((consp nosuffix
) nosuffix
)
743 (t '(".elc" ".el" ""))))
746 (setq suffixes suffixes-to-try
)
748 (setq try
(ffap-file-exists-string
750 (concat file
(car suffixes
)) (car path
))))
751 (if (and try
(or dir-ok
(not (file-directory-p try
))))
752 (setq found try suffixes nil path nil
)
753 (setq suffixes
(cdr suffixes
))))
754 (setq path
(cdr path
)))
758 ;;; Action List (`ffap-alist'):
760 ;; These search actions depend on the major-mode or regexps matching
761 ;; the current name. The little functions and their variables are
762 ;; deferred to the next section, at some loss of "code locality". A
763 ;; good example of featuritis. Trim this list for speed.
767 ("" . ffap-completable
) ; completion, slow on some systems
768 ("\\.info\\'" . ffap-info
) ; gzip.info
769 ("\\`info/" . ffap-info-2
) ; info/emacs
770 ("\\`[-[:lower:]]+\\'" . ffap-info-3
) ; (emacs)Top [only in the parentheses]
771 ("\\.elc?\\'" . ffap-el
) ; simple.el, simple.elc
772 (emacs-lisp-mode . ffap-el-mode
) ; rmail, gnus, simple, custom
773 ;; (lisp-interaction-mode . ffap-el-mode) ; maybe
774 (finder-mode . ffap-el-mode
) ; type {C-h p} and try it
775 (help-mode . ffap-el-mode
) ; maybe useful
776 (c++-mode . ffap-c
++-mode
) ; search ffap-c++-path
777 (cc-mode . ffap-c-mode
) ; same
778 ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode
) ; stdio.h
779 (fortran-mode . ffap-fortran-mode
) ; FORTRAN requested by MDB
780 ("\\.[fF]\\'" . ffap-fortran-mode
)
781 (tex-mode . ffap-tex-mode
) ; search ffap-tex-path
782 (latex-mode . ffap-latex-mode
) ; similar
783 ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex
)
784 ("\\.bib\\'" . ffap-bib
) ; search ffap-bib-path
785 ("\\`\\." . ffap-home
) ; .emacs, .bashrc, .profile
786 ("\\`~/" . ffap-lcd
) ; |~/misc/ffap.el.Z|
787 ;; This used to have a blank, but ffap-string-at-point doesn't
789 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html
790 ("\\`[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $
791 . ffap-rfc
) ; "100% RFC2100 compliant"
792 (dired-mode . ffap-dired
) ; maybe in a subdirectory
794 "Alist of (KEY . FUNCTION) pairs parsed by `ffap-file-at-point'.
795 If string NAME at point (maybe \"\") is not a file or URL, these pairs
796 specify actions to try creating such a string. A pair matches if either
797 KEY is a symbol, and it equals `major-mode', or
798 KEY is a string, it should match NAME as a regexp.
799 On a match, (FUNCTION NAME) is called and should return a file, an
800 URL, or nil. If nil, search the alist for further matches.
801 While calling FUNCTION, the match data is set according to KEY if KEY
802 is a string, so that FUNCTION can use `match-string' and friends
803 to extract substrings.")
805 (put 'ffap-alist
'risky-local-variable t
)
807 ;; Example `ffap-alist' modifications:
809 ;; (setq ffap-alist ; remove a feature in `ffap-alist'
810 ;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
812 ;; (setq ffap-alist ; add something to `ffap-alist'
814 ;; (cons "^YSN[0-9]+$"
815 ;; (defun ffap-ysn (name)
817 ;; "http://www.physics.uiuc.edu/"
818 ;; "ysn/httpd/htdocs/ysnarchive/issuefiles/"
819 ;; (substring name 3) ".html")))
823 ;;; Action Definitions:
825 ;; Define various default members of `ffap-alist'.
827 (defun ffap-completable (name)
828 (let* ((dir (or (file-name-directory name
) default-directory
))
829 (cmp (file-name-completion (file-name-nondirectory name
) dir
)))
830 (and cmp
(concat dir cmp
))))
832 (defun ffap-home (name) (ffap-locate-file name t
'("~")))
834 (defun ffap-info (name)
837 (or (ffap-symbol-value 'Info-directory-list
)
838 (ffap-symbol-value 'Info-default-directory-list
)
841 (defun ffap-info-2 (name) (ffap-info (substring name
5)))
843 (defun ffap-info-3 (name)
844 ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
845 (and (equal (ffap-string-around) "()") (ffap-info name
)))
847 (defun ffap-el (name) (ffap-locate-file name t load-path
))
849 (defun ffap-el-mode (name)
850 ;; If name == "foo.el" we will skip it, since ffap-el already
851 ;; searched for it once. (This assumes the default ffap-alist.)
852 (and (not (string-match "\\.el\\'" name
))
853 (ffap-locate-file name
'(".el") load-path
)))
855 ;; FIXME this duplicates the logic of Man-header-file-path.
856 ;; There should be a single central variable or function for this.
857 ;; See also (bug#10702):
858 ;; cc-search-directories, semantic-c-dependency-system-include-path,
859 ;; semantic-gcc-setup
861 (let ((arch (with-temp-buffer
862 (when (eq 0 (ignore-errors
863 (call-process "gcc" nil
'(t nil
) nil
864 "-print-multiarch")))
865 (goto-char (point-min))
866 (buffer-substring (point) (line-end-position)))))
867 (base '("/usr/include" "/usr/local/include")))
868 (if (zerop (length arch
))
870 (append base
(list (expand-file-name arch
"/usr/include")))))
871 "List of directories to search for include files.")
873 (defun ffap-c-mode (name)
874 (ffap-locate-file name t ffap-c-path
))
876 (defvar ffap-c
++-path
877 (let ((c++-include-dir
(with-temp-buffer
878 (when (eq 0 (ignore-errors
879 (call-process "g++" nil t nil
"-v")))
880 (goto-char (point-min))
881 (if (re-search-forward "--with-gxx-include-dir=\
885 (when (re-search-forward "gcc version \
886 \\([[:digit:]]+.[[:digit:]]+.[[:digit:]]+\\)"
888 (expand-file-name (match-string 1)
889 "/usr/include/c++/")))))))
891 (cons c
++-include-dir ffap-c-path
)
893 "List of directories to search for include files.")
895 (defun ffap-c++-mode
(name)
896 (ffap-locate-file name t ffap-c
++-path
))
898 (defvar ffap-fortran-path
'("../include" "/usr/include"))
900 (defun ffap-fortran-mode (name)
901 (ffap-locate-file name t ffap-fortran-path
))
903 (defvar ffap-tex-path
904 t
; delayed initialization
905 "Path where `ffap-tex-mode' looks for TeX files.
906 If t, `ffap-tex-init' will initialize this when needed.")
908 (defvar ffap-latex-guess-rules
'(("" .
".sty")
912 ("" .
"") ;; in some rare cases the
913 ;; extension is already in
915 ("beamertheme" .
".sty")
916 ("beamercolortheme".
".sty")
917 ("beamerfonttheme".
".sty")
918 ("beamerinnertheme".
".sty")
919 ("beameroutertheme".
".sty")
921 "List of rules for guessing a filename.
922 Each rule is a cons (PREFIX . SUFFIX) used for guessing a
923 filename from the word at point by prepending PREFIX and
926 (defun ffap-tex-init ()
927 ;; Compute ffap-tex-path if it is now t.
928 (and (eq t ffap-tex-path
)
929 ;; this may be slow, so say something
930 (message "Initializing ffap-tex-path ...")
935 (ffap-kpathsea-expand-path
937 (ffap-list-env "TEXINPUTS")
938 ;; (ffap-list-env "BIBINPUTS")
940 'TeX-macro-global
; AUCTeX
941 '("/usr/local/lib/tex/macros"
942 "/usr/local/lib/tex/inputs")))))))))
944 (defun ffap-tex-mode (name)
946 (ffap-locate-file name
'(".tex" "") ffap-tex-path
))
948 (defun ffap-latex-mode (name)
949 "`ffap' function suitable for latex buffers.
950 This uses the program kpsewhich if available. In this case, the
951 variable `ffap-latex-guess-rules' is used for building a filename
953 (cond ((file-exists-p name
)
955 ((not (executable-find "kpsewhich"))
957 (ffap-locate-file name
'(".cls" ".sty" ".tex" "") ffap-tex-path
))
959 (let ((curbuf (current-buffer))
960 (guess-rules ffap-latex-guess-rules
)
961 (preferred-suffix-rules '(("input" .
".tex")
963 ("usepackage" .
".sty")
964 ("RequirePackageWithOptions" .
".sty")
965 ("RequirePackage" .
".sty")
966 ("documentclass" .
".cls")
967 ("documentstyle" .
".cls")
968 ("LoadClass" .
".cls")
969 ("LoadClassWithOptions" .
".cls")
970 ("bibliography" .
".bib")
971 ("addbibresource" .
""))))
972 ;; We now add preferred suffix in front of suffixes.
974 ;; The condition is essentially:
975 ;; (assoc (TeX-current-macro)
976 ;; (mapcar 'car preferred-suffix-rules))
977 ;; but (TeX-current-macro) can take time, so we just
978 ;; check if one of the `car' in preferred-suffix-rules
979 ;; is found before point on the current line. It
980 ;; should cover most cases.
982 (re-search-backward (regexp-opt
983 (mapcar 'car preferred-suffix-rules
))
986 (push (cons "" (cdr (assoc (match-string 0) ; i.e. "(TeX-current-macro)"
987 preferred-suffix-rules
)))
990 (let ((process-environment (buffer-local-value
991 'process-environment curbuf
))
992 (exec-path (buffer-local-value 'exec-path curbuf
)))
993 (apply #'call-process
"kpsewhich" nil t nil
994 (mapcar (lambda (rule)
995 (concat (car rule
) name
(cdr rule
)))
997 (when (< (point-min) (point-max))
998 (buffer-substring (goto-char (point-min)) (point-at-eol))))))))
1000 (defun ffap-tex (name)
1002 (ffap-locate-file name t ffap-tex-path
))
1004 (defvar ffap-bib-path
1005 (ffap-list-env "BIBINPUTS"
1008 ;; a few wild guesses, need better
1009 "/usr/local/lib/tex/macros/bib" ; Solaris?
1010 "/usr/lib/texmf/bibtex/bib" ; Linux?
1013 (defun ffap-bib (name)
1014 (ffap-locate-file name t ffap-bib-path
))
1016 (defun ffap-dired (name)
1017 (let ((pt (point)) try
)
1021 (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
1022 (re-search-backward "^ *$" nil t
)
1023 (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t
)
1029 (match-beginning 1) (match-end 1)))))
1032 ;; Maybe a "Lisp Code Directory" reference:
1033 (defun ffap-lcd (name)
1034 ;; FIXME: Is this still in use?
1037 ;; lisp-dir-apropos output buffer:
1038 (string-match "Lisp Code Dir" (buffer-name))
1039 ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
1040 ;; or maybe the holy LCD-Datafile itself:
1041 (member (ffap-string-around) '("||" "|\n")))
1043 ;; lispdir.el may not be loaded yet:
1044 (ffap-host-to-filename
1045 (ffap-symbol-value 'elisp-archive-host
1046 "archive.cis.ohio-state.edu"))
1047 (file-name-as-directory
1048 (ffap-symbol-value 'elisp-archive-directory
1049 "/pub/gnu/emacs/elisp-archive/"))
1050 (substring name
2))))
1052 (defcustom ffap-rfc-path
1053 (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt")
1054 "A `format' string making a filename for RFC documents.
1055 This can be an ange-ftp or Tramp remote filename to download, or
1056 a local filename if you have full set of RFCs locally. See also
1057 `ffap-rfc-directories'."
1062 (defcustom ffap-rfc-directories nil
1063 "A list of directories to look for RFC files.
1064 If a given RFC isn't in these then `ffap-rfc-path' is offered."
1065 :type
'(repeat directory
)
1069 (defun ffap-rfc (name)
1070 (let ((num (match-string 1 name
)))
1071 (or (ffap-locate-file (format "rfc%s.txt" num
) t ffap-rfc-directories
)
1072 (format ffap-rfc-path num
))))
1075 ;;; At-Point Functions:
1077 (defvar ffap-string-at-point-mode-alist
1079 ;; The default, used when the `major-mode' is not found.
1080 ;; Slightly controversial decisions:
1081 ;; * strip trailing "@" and ":"
1082 ;; * no commas (good for latex)
1083 (file "--:\\\\${}+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
1084 ;; An url, or maybe a email/news message-id:
1085 (url "--:=&?$+@-Z_[:alpha:]~#,%;*()!'" "^[0-9a-zA-Z]" ":;.,!?")
1086 ;; Find a string that does *not* contain a colon:
1087 (nocolon "--9$+<>@-Z_[:alpha:]~" "<@" "@>;.,!?")
1089 (machine "-[:alnum:]." "" ".")
1090 ;; Mathematica paths: allow backquotes
1091 (math-mode ",-:$+<>@-Z_[:lower:]~`" "<" "@>;.,!?`:")
1092 ;; (La)TeX: don't allow braces
1093 (latex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
1094 (tex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
1096 "Alist of (MODE CHARS BEG END), where MODE is a symbol,
1097 possibly a major-mode name, or one of the symbols
1098 `file', `url', `machine', and `nocolon'.
1099 Function `ffap-string-at-point' uses the data fields as follows:
1100 1. find a maximal string of CHARS around point,
1101 2. strip BEG chars before point from the beginning,
1102 3. strip END chars after point from the end.
1103 The arguments CHARS, BEG and END are handled as described in
1104 `skip-chars-forward'.")
1106 (defvar ffap-string-at-point nil
1107 ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
1108 "Last string returned by the function `ffap-string-at-point'.")
1110 (defun ffap-string-at-point (&optional mode
)
1111 "Return a string of characters from around point.
1113 MODE (defaults to value of `major-mode') is a symbol used to look up
1114 string syntax parameters in `ffap-string-at-point-mode-alist'.
1116 If MODE is not found, we use `file' instead of MODE.
1118 If the region is active, return a string from the region.
1120 If the point is in a comment, ensure that the returned string does not
1121 contain the comment start characters (especially for major modes that
1122 have '//' as comment start characters).
1124 Set the variables `ffap-string-at-point' and
1125 `ffap-string-at-point-region'.
1127 When the region is active and larger than `ffap-max-region-length',
1128 return an empty string, and set `ffap-string-at-point-region' to '(1 1)."
1131 (or (assq (or mode major-mode
) ffap-string-at-point-mode-alist
)
1132 (assq 'file ffap-string-at-point-mode-alist
))))
1133 (region-selected (use-region-p))
1135 (beg (if region-selected
1138 (skip-chars-backward (car args
))
1139 (skip-chars-forward (nth 1 args
) pt
)
1141 (end (if region-selected
1144 (skip-chars-forward (car args
))
1145 (skip-chars-backward (nth 2 args
) pt
)
1147 (region-len (- (max beg end
) (min beg end
))))
1149 ;; If the initial characters of the to-be-returned string are the
1150 ;; current major mode's comment starter characters, *and* are
1151 ;; not part of a comment, remove those from the returned string
1153 ;; Example comments in `c-mode' (which considers lines beginning
1154 ;; with "//" as comments):
1155 ;; //tmp - This is a comment. It does not contain any path reference.
1156 ;; ///tmp - This is a comment. The "/tmp" portion in that is a path.
1157 ;; ////tmp - This is a comment. The "//tmp" portion in that is a path.
1159 ;; Proceed if no region is selected by the user.
1160 (null region-selected
)
1161 ;; Check if END character is part of a comment.
1163 (nth 4 (syntax-ppss end
))))
1164 ;; Move BEG to beginning of comment (after the comment start
1165 ;; characters), or END, whichever comes first.
1167 (let ((state (syntax-ppss beg
)))
1168 ;; (nth 4 (syntax-ppss)) will be nil for comment start chars.
1169 (unless (nth 4 state
)
1170 (parse-partial-sexp beg end nil nil state
:commentstop
)
1171 (setq beg
(point))))))
1173 (if (and (natnump ffap-max-region-length
)
1174 (< region-len ffap-max-region-length
)) ; Bug#25243.
1175 (setf ffap-string-at-point-region
(list beg end
)
1176 ffap-string-at-point
1177 (buffer-substring-no-properties beg end
))
1178 (setf ffap-string-at-point-region
(list 1 1)
1179 ffap-string-at-point
""))))
1181 (defun ffap-string-around ()
1182 ;; Sometimes useful to decide how to treat a string.
1183 "Return string of two chars around last result of function
1184 `ffap-string-at-point'.
1185 Assumes the buffer has not changed."
1189 (goto-char (car ffap-string-at-point-region
))
1190 (preceding-char)) ; maybe 0
1192 (goto-char (nth 1 ffap-string-at-point-region
))
1193 (following-char)) ; maybe 0
1196 (defun ffap-copy-string-as-kill (&optional mode
)
1197 ;; Requested by MCOOK. Useful?
1198 "Call function `ffap-string-at-point', and copy result to `kill-ring'."
1200 (let ((str (ffap-string-at-point mode
)))
1202 (message "No string found around point.")
1204 ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
1205 (message "Copied to kill ring: %s" str
))))
1208 (declare-function w3-view-this-url
"ext:w3" (&optional no-show
))
1210 (defun ffap-url-at-point ()
1211 "Return URL from around point if it exists, or nil.
1213 Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any."
1214 (when ffap-url-regexp
1215 (or (and (eq major-mode
'w3-mode
) ; In a w3 buffer button?
1216 (w3-view-this-url t
))
1217 (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp
)
1218 (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix
)
1220 (setq val
(thing-at-point-url-at-point ffap-lax-url
1222 (cons (region-beginning)
1225 (let ((bounds (thing-at-point-bounds-of-url-at-point
1227 (setq ffap-string-at-point-region
1228 (list (car bounds
) (cdr bounds
)))))
1231 (defvar ffap-gopher-regexp
1232 "\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *"
1233 "Regexp matching a key in a gopher bookmark.
1234 Set to nil to disable matching gopher bookmarks.")
1236 (defun ffap--gopher-var-on-line ()
1237 "Return (KEY . VALUE) of gopher bookmark on current line."
1239 (let ((eol (progn (end-of-line) (skip-chars-backward " ") (point)))
1240 (bol (progn (beginning-of-line) (point))))
1241 (when (re-search-forward ffap-gopher-regexp eol t
)
1242 (let ((key (match-string 1))
1243 (val (buffer-substring-no-properties (match-end 0) eol
)))
1244 (cons (intern (downcase key
)) val
))))))
1246 (defun ffap-gopher-at-point ()
1247 "If point is inside a gopher bookmark block, return its URL.
1249 Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any."
1250 ;; `gopher-parse-bookmark' from gopher.el is not so robust
1251 (when (stringp ffap-gopher-regexp
)
1253 (let* ((beg (progn (beginning-of-line)
1254 (while (and (not (bobp)) (ffap--gopher-var-on-line))
1257 (bookmark (cl-loop for keyval
= (ffap--gopher-var-on-line)
1258 while keyval collect keyval
1259 do
(forward-line 1))))
1261 (setq ffap-string-at-point-region
(list beg
(point)))
1262 (let-alist (nconc bookmark
'((type .
"1") (port .
"70")))
1263 (if (and .path
(string-match "\\`ftp:.*@" .path
))
1265 (substring .path
4 (1- (match-end 0)))
1266 (substring .path
(match-end 0)))
1267 (and (= (length .type
) 1)
1268 .host
;; (ffap-machine-p host)
1269 (concat "gopher://" .host
1270 (if (equal .port
"70") "" (concat ":" .port
))
1271 "/" .type .path
)))))))))
1273 (defvar ffap-ftp-sans-slash-regexp
1276 ;; Note: by now, we know it is not an url.
1277 ;; Icky regexp avoids: default: 123: foo::bar cs:pub
1278 ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
1279 "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
1280 "Strings matching this are coerced to FTP file names by ffap.
1281 That is, ffap just prepends \"/\". Set to nil to disable.")
1283 (defun ffap-file-at-point ()
1284 "Return filename from around point if it exists, or nil.
1285 Existence test is skipped for names that look remote.
1286 If the filename is not obvious, it also tries `ffap-alist',
1287 which may actually result in an URL rather than a filename."
1288 ;; Note: this function does not need to look for url's, just
1289 ;; filenames. On the other hand, it is responsible for converting
1290 ;; a pseudo-url "site.com://dir" to an ftp file name
1291 (let* ((case-fold-search t
) ; url prefixes are case-insensitive
1293 (string (ffap-string-at-point)) ; uses mode alist
1295 (or (condition-case nil
1296 (and (not (string-match "//" string
)) ; foo.com://bar
1297 (substitute-in-file-name string
))
1300 (abs (file-name-absolute-p name
))
1301 (default-directory default-directory
)
1305 ;; Immediate rejects (/ and // and /* are too common in C/C++):
1306 ((member name
'("" "/" "//" "/*" ".")) nil
)
1307 ;; Immediately test local filenames. If default-directory is
1308 ;; remote, you probably already have a connection.
1309 ((and (not abs
) (ffap-file-exists-string name
)))
1310 ;; Try stripping off line numbers; good for compilation/grep output.
1311 ((and (not abs
) (string-match ":[0-9]" name
)
1312 (ffap-file-exists-string (substring name
0 (match-beginning 0)))))
1313 ;; Try stripping off prominent (non-root - #) shell prompts
1314 ;; if the ffap-shell-prompt-regexp is non-nil.
1315 ((and ffap-shell-prompt-regexp
1316 (not abs
) (string-match ffap-shell-prompt-regexp name
)
1317 (ffap-file-exists-string (substring name
(match-end 0)))))
1318 ;; Accept remote names without actual checking (too slow):
1319 ((and abs
(ffap-file-remote-p name
)))
1320 ;; Ok, not remote, try the existence test even if it is absolute:
1321 ((and abs
(ffap-file-exists-string name
)))
1322 ;; Try stripping off line numbers.
1323 ((and abs
(string-match ":[0-9]" name
)
1324 (ffap-file-exists-string (substring name
0 (match-beginning 0)))))
1325 ;; If it contains a colon, get rid of it (and return if exists)
1326 ((and (string-match path-separator name
)
1327 (setq name
(ffap-string-at-point 'nocolon
))
1328 (ffap-file-exists-string name
)))
1329 ;; File does not exist, try the alist:
1330 ((let ((alist ffap-alist
) tem try case-fold-search
)
1331 (while (and alist
(not try
))
1332 (setq tem
(car alist
) alist
(cdr alist
))
1333 (if (or (eq major-mode
(car tem
))
1334 (and (stringp (car tem
))
1335 (string-match (car tem
) name
)))
1338 (funcall (cdr tem
) name
)
1341 (ffap-url-p try
) ; not a file!
1342 (ffap-file-remote-p try
)
1343 (ffap-file-exists-string try
))))))
1345 ;; Try adding a leading "/" (common omission in ftp file names).
1346 ;; Note that this uses oname, which still has any colon part.
1347 ;; This should have a lower priority than the alist stuff,
1348 ;; else it matches things like "ffap.el:1234:56:Warning".
1350 ffap-ftp-sans-slash-regexp
1351 (string-match ffap-ftp-sans-slash-regexp oname
)
1352 (ffap-file-remote-p (concat "/" oname
))))
1353 ;; Alist failed? Try to guess an active remote connection
1354 ;; from buffer variables, and try once more, both as an
1355 ;; absolute and relative file name on that remote host.
1356 ((let* (ffap-rfs-regexp ; suppress
1359 ((ffap-file-remote-p default-directory
))
1360 ((and (eq major-mode
'internal-ange-ftp-mode
)
1361 (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$"
1363 (concat "/" (substring (buffer-name) 5 -
1) ":"))
1364 ;; This is too often a bad idea:
1365 ;;((and (eq major-mode 'w3-mode)
1366 ;; (stringp url-current-server))
1367 ;; (host-to-ange-path url-current-server))
1371 (and (string-match "\\`\\(/?~?ftp\\)/" name
)
1372 (ffap-file-exists-string
1373 (ffap-replace-file-component
1374 remote-dir
(substring name
(match-end 1)))))
1375 (ffap-file-exists-string
1376 (ffap-replace-file-component remote-dir name
))))))
1377 ((and ffap-dired-wildcards
1378 (string-match ffap-dired-wildcards name
)
1380 (ffap-file-exists-string (file-name-directory
1381 (directory-file-name name
)))
1383 ;; Try all parent directories by deleting the trailing directory
1384 ;; name until existing directory is found or name stops changing
1387 (not (ffap-file-exists-string dir
))
1388 (not (equal dir
(setq dir
(file-name-directory
1389 (directory-file-name dir
)))))))
1390 (and (not (string= dir
"/"))
1391 (ffap-file-exists-string dir
))))
1393 (set-match-data data
))))
1395 ;;; Prompting (`ffap-read-file-or-url'):
1397 ;; We want to complete filenames as in read-file-name, but also url's
1398 ;; which read-file-name-internal would truncate at the "//" string.
1399 ;; The solution here is to replace read-file-name-internal with
1400 ;; `ffap-read-file-or-url-internal', which checks the minibuffer
1401 ;; contents before attempting to complete filenames.
1403 (defun ffap-read-file-or-url (prompt guess
)
1404 "Read file or URL from minibuffer, with PROMPT and initial GUESS."
1405 (or guess
(setq guess default-directory
))
1407 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
1408 ;; or "w3/" or "../el/ffap.el" or "../../../"
1409 (unless (ffap-url-p guess
)
1410 (unless (ffap-file-remote-p guess
)
1412 (abbreviate-file-name (expand-file-name guess
))))
1413 (setq dir
(file-name-directory guess
)))
1414 (let ((minibuffer-completing-file-name t
)
1415 (completion-ignore-case read-file-name-completion-ignore-case
)
1416 (fnh-elem (cons ffap-url-regexp
'url-file-handler
)))
1417 ;; Explain to `rfn-eshadow' that we can use URLs here.
1418 (push fnh-elem file-name-handler-alist
)
1421 (let ((default-directory (if dir
(expand-file-name dir
)
1422 default-directory
)))
1425 'ffap-read-file-or-url-internal
1428 (if dir
(cons guess
(length dir
)) guess
)
1430 (and buffer-file-name
1431 (abbreviate-file-name buffer-file-name
)))))
1432 ;; Remove the special handler manually. We used to just let-bind
1433 ;; file-name-handler-alist to preserve its value, but that caused
1434 ;; other modifications to be lost (e.g. when Tramp gets loaded
1435 ;; during the completing-read call).
1436 (setq file-name-handler-alist
(delq fnh-elem file-name-handler-alist
))))
1437 (or (ffap-url-p guess
)
1438 (substitute-in-file-name guess
))))
1440 (defun ffap-read-url-internal (string pred action
)
1441 "Complete URLs from history, treating given string as valid."
1442 (let ((hist (ffap-symbol-value 'url-global-history-hash-table
)))
1445 (or (try-completion string hist pred
) string
))
1447 (or (all-completions string hist pred
) (list string
)))
1448 ;; action == lambda, documented where? Tests whether string is a
1449 ;; valid "match". Let us always say yes.
1452 (defun ffap-read-file-or-url-internal (string pred action
)
1453 (let ((url (ffap-url-p string
)))
1455 (ffap-read-url-internal url pred action
)
1456 (read-file-name-internal (or string default-directory
) pred action
))))
1458 ;; The rest of this page is just to work with package complete.el.
1459 ;; This code assumes that you load ffap.el after complete.el.
1461 ;; We must inform complete about whether our completion function
1462 ;; will do filename style completion.
1465 ;;; Highlighting (`ffap-highlight'):
1467 (defvar ffap-highlight t
1468 "If non-nil, ffap highlights the current buffer substring.")
1471 '((t :inherit highlight
))
1472 "Face used to highlight the current buffer substring."
1476 (defvar ffap-highlight-overlay nil
1477 "Overlay used by function `ffap-highlight'.")
1479 (defun ffap-highlight (&optional remove
)
1480 "If `ffap-highlight' is set, highlight the guess in this buffer.
1481 That is, the last buffer substring found by `ffap-string-at-point'.
1482 Optional argument REMOVE means to remove any such highlighting.
1483 Uses the face `ffap' if it is defined, or else `highlight'."
1486 (and ffap-highlight-overlay
1487 (delete-overlay ffap-highlight-overlay
))
1489 ((not ffap-highlight
) nil
)
1490 (ffap-highlight-overlay
1492 ffap-highlight-overlay
1493 (car ffap-string-at-point-region
)
1494 (nth 1 ffap-string-at-point-region
)
1497 (setq ffap-highlight-overlay
1498 (apply 'make-overlay ffap-string-at-point-region
))
1499 (overlay-put ffap-highlight-overlay
'face
'ffap
))))
1502 ;;; Main Entrance (`find-file-at-point' == `ffap'):
1504 (defun ffap-guesser ()
1505 "Return file or URL or nil, guessed from text around point."
1506 (or (and ffap-url-regexp
1507 (ffap-fixup-url (or (ffap-url-at-point)
1508 (ffap-gopher-at-point))))
1509 (ffap-file-at-point) ; may yield url!
1510 (ffap-fixup-machine (ffap-machine-at-point))))
1512 (defun ffap-prompter (&optional guess
)
1513 ;; Does guess and prompt step for find-file-at-point.
1514 ;; Extra complication for the temporary highlighting.
1516 ;; This catch will let ffap-alist entries do their own prompting
1517 ;; and then maybe skip over this prompt (ff-paths, for example).
1518 (catch 'ffap-prompter
1519 (ffap-read-file-or-url
1520 (if ffap-url-regexp
"Find file or URL: " "Find file: ")
1522 (let ((mark-active nil
))
1523 ;; Don't use the region here, since it can be something
1524 ;; completely unwieldy. If the user wants that, she could
1525 ;; use M-w before and then C-y. --Stef
1526 (setq guess
(or guess
(ffap-guesser)))) ; using ffap-alist here
1527 (and guess
(ffap-highlight))
1529 (ffap-highlight t
)))
1532 (defun find-file-at-point (&optional filename
)
1533 "Find FILENAME, guessing a default from text around point.
1534 If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
1535 With a prefix, this command behaves exactly like `ffap-file-finder'.
1536 If `ffap-require-prefix' is set, the prefix meaning is reversed.
1537 See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
1538 `ffap-url-unwrap-local', `ffap-url-unwrap-remote', and the functions
1539 `ffap-file-at-point' and `ffap-url-at-point'."
1541 (if (and (called-interactively-p 'interactive
)
1542 (if ffap-require-prefix
(not current-prefix-arg
)
1543 current-prefix-arg
))
1544 ;; Do exactly the ffap-file-finder command, even the prompting:
1545 (let (current-prefix-arg) ; we already interpreted it
1546 (call-interactively ffap-file-finder
))
1547 (or filename
(setq filename
(ffap-prompter)))
1548 (let ((url (ffap-url-p filename
)))
1551 (let (current-prefix-arg)
1552 (funcall ffap-url-fetcher url
)))
1553 ((and ffap-pass-wildcards-to-dired
1554 ffap-dired-wildcards
1555 (string-match ffap-dired-wildcards filename
))
1556 (funcall ffap-directory-finder filename
))
1557 ((and ffap-dired-wildcards
1558 (string-match ffap-dired-wildcards filename
)
1560 ;; Check if it's find-file that supports wildcards arg
1561 (memq ffap-file-finder
'(find-file find-alternate-file
)))
1562 (funcall ffap-file-finder
(expand-file-name filename
) t
))
1563 ((or (not ffap-newfile-prompt
)
1564 (file-exists-p filename
)
1565 (y-or-n-p "File does not exist, create buffer? "))
1566 (funcall ffap-file-finder
1567 ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
1568 (expand-file-name filename
)))
1569 ;; User does not want to find a non-existent file:
1570 ((signal 'file-missing
(list "Opening file buffer"
1571 "No such file or directory"
1574 ;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
1576 (defalias 'ffap
'find-file-at-point
)
1579 ;;; Menu support (`ffap-menu'):
1581 (defcustom ffap-menu-regexp nil
1582 "If non-nil, regexp overriding `ffap-next-regexp' in `ffap-menu'.
1583 Make this more restrictive for faster menu building.
1584 For example, try \":/\" for URL (and some FTP) references."
1585 :type
'(choice (const nil
) regexp
)
1588 (defvar ffap-menu-alist nil
1589 "Buffer local cache of menu presented by `ffap-menu'.")
1590 (make-variable-buffer-local 'ffap-menu-alist
)
1592 (defvar ffap-menu-text-plist
1594 ((display-mouse-p) '(face bold mouse-face highlight
)) ; keymap <mousy-map>
1596 "Text properties applied to strings found by `ffap-menu-rescan'.
1597 These properties may be used to fontify the menu references.")
1600 (defun ffap-menu (&optional rescan
)
1601 "Put up a menu of files and URLs mentioned in this buffer.
1602 Then set mark, jump to choice, and try to fetch it. The menu is
1603 cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
1604 The optional RESCAN argument (a prefix, interactively) forces
1605 a rebuild. Searches with `ffap-menu-regexp'."
1607 ;; (require 'imenu) -- no longer used, but roughly emulated
1608 (if (or (not ffap-menu-alist
) rescan
1609 ;; or if the first entry is wrong:
1610 (and ffap-menu-alist
1611 (let ((first (car ffap-menu-alist
)))
1613 (goto-char (cdr first
))
1614 (not (equal (car first
) (ffap-guesser)))))))
1618 (if ffap-url-regexp
"Find file or URL" "Find file")
1619 (cons (cons "*Rescan Buffer*" -
1) ffap-menu-alist
)
1622 (defun ffap-menu-cont (choice) ; continuation of ffap-menu
1623 (if (< (cdr choice
) 0)
1624 (ffap-menu t
) ; *Rescan*
1626 (goto-char (cdr choice
))
1627 ;; Momentary highlight:
1630 (and ffap-highlight
(ffap-guesser) (ffap-highlight))
1631 (sit-for 0) ; display
1632 (find-file-at-point (car choice
)))
1633 (ffap-highlight t
))))
1635 (defun ffap-menu-ask (title alist cont
)
1636 "Prompt from a menu of choices, and then apply some action.
1637 Arguments are TITLE, ALIST, and CONT (a continuation function).
1638 This uses either a menu or the minibuffer depending on invocation.
1639 The TITLE string is used as either the prompt or menu title.
1640 Each ALIST entry looks like (STRING . DATA) and defines one choice.
1641 Function CONT is applied to the entry chosen by the user."
1642 ;; Note: this function is used with a different continuation
1643 ;; by the ffap-url add-on package.
1644 ;; Could try rewriting to use easymenu.el or lmenu.el.
1648 ((and (fboundp 'x-popup-menu
) (ffap-mouse-event))
1652 (list "" (cons title
1653 (mapcar (lambda (i) (cons (car i
) i
))
1655 ;; minibuffer with completion buffer:
1657 (let ((minibuffer-setup-hook 'minibuffer-completion-help
))
1658 ;; Bug: prompting may assume unique strings, no "".
1661 (format "%s (default %s): " title
(car (car alist
)))
1663 ;; (cons (car (car alist)) 0)
1665 (sit-for 0) ; redraw original screen
1666 ;; Convert string to its entry, or else the default:
1667 (setq choice
(or (assoc choice alist
) (car alist
)))))
1669 (funcall cont choice
)
1670 (message "No choice made!") ; possible with menus
1673 (defun ffap-menu-rescan ()
1674 "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
1675 Applies `ffap-menu-text-plist' text properties at all matches."
1677 (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp
))
1678 (range (- (point-max) (point-min)))
1679 (mod (buffer-modified-p)) ; was buffer modified?
1680 ;; inhibit-read-only works on read-only text properties
1681 ;; as well as read-only buffers.
1682 (inhibit-read-only t
) ; to set text-properties
1684 ;; Avoid repeated searches of the *mode-alist:
1685 (major-mode (if (assq major-mode ffap-string-at-point-mode-alist
)
1688 (setq ffap-menu-alist nil
)
1691 (goto-char (point-min))
1692 (while (setq item
(ffap-next-guess))
1693 (setq ffap-menu-alist
(cons (cons item
(point)) ffap-menu-alist
))
1694 (add-text-properties (car ffap-string-at-point-region
) (point)
1695 ffap-menu-text-plist
)
1696 (message "Scanning...%2d%% <%s>"
1697 (floor (* 100.0 (- (point) (point-min))) range
) item
)))
1698 (or mod
(restore-buffer-modified-p nil
))))
1699 (message "Scanning...done")
1700 ;; Remove duplicates.
1701 (setq ffap-menu-alist
; sort by item
1702 (sort ffap-menu-alist
1704 (lambda (a b
) (string-lessp (car a
) (car b
))))))
1705 (let ((ptr ffap-menu-alist
)) ; remove duplicates
1707 (if (equal (car (car ptr
)) (car (car (cdr ptr
))))
1708 (setcdr ptr
(cdr (cdr ptr
)))
1709 (setq ptr
(cdr ptr
)))))
1710 (setq ffap-menu-alist
; sort by position
1711 (sort ffap-menu-alist
1713 (lambda (a b
) (< (cdr a
) (cdr b
)))))))
1716 ;;; Mouse Support (`ffap-at-mouse'):
1718 ;; See the suggested binding in ffap-bindings (near eof).
1720 (defvar ffap-at-mouse-fallback nil
; ffap-menu? too time-consuming
1721 "Command invoked by `ffap-at-mouse' if nothing found at click, or nil.
1722 Ignored when `ffap-at-mouse' is called programmatically.")
1723 (put 'ffap-at-mouse-fallback
'risky-local-variable t
)
1726 (defun ffap-at-mouse (e)
1727 "Find file or URL guessed from text around mouse click.
1728 Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
1730 * if a guess string is found, return it (after finding it)
1731 * if the fallback is called, return whatever it returns
1735 ;; Maybe less surprising without the save-excursion?
1738 ;; Would prefer to do nothing unless click was *on* text. How
1739 ;; to tell that the click was beyond the end of current line?
1743 (set-buffer (ffap-event-buffer e
))
1747 (sit-for 0) ; display
1748 (message "Finding `%s'" guess
)
1749 (find-file-at-point guess
)
1750 guess
) ; success: return non-nil
1751 (ffap-highlight t
)))
1752 ((called-interactively-p 'interactive
)
1753 (if ffap-at-mouse-fallback
1754 (call-interactively ffap-at-mouse-fallback
)
1755 (message "No file or URL found at mouse click.")
1756 nil
)) ; no fallback, return nil
1757 ;; failure: return nil
1761 ;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands:
1763 ;; There could be a real `ffap-noselect' function, but we would need
1764 ;; at least two new user variables, and there is no w3-fetch-noselect.
1765 ;; So instead, we just fake it with a slow save-window-excursion.
1767 (defun ffap-other-window ()
1768 "Like `ffap', but put buffer in another window.
1769 Only intended for interactive use."
1771 (pcase (save-window-excursion (call-interactively 'ffap
))
1772 ((or (and (pred bufferp
) b
) `(,(and (pred bufferp
) b
) .
,_
))
1773 (switch-to-buffer-other-window b
))))
1775 (defun ffap-other-frame ()
1776 "Like `ffap', but put buffer in another frame.
1777 Only intended for interactive use."
1779 ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1780 (let* ((win (selected-window))
1781 (wdp (window-dedicated-p win
))
1785 (set-window-dedicated-p win nil
)
1786 (switch-to-buffer-other-frame
1787 (save-window-excursion
1788 (setq value
(call-interactively 'ffap
))
1789 (unless (or (bufferp value
) (bufferp (car-safe value
)))
1790 (setq value
(current-buffer)))
1792 (set-window-dedicated-p win wdp
))
1795 (defun ffap--toggle-read-only (buffer-or-list)
1796 (dolist (buffer (if (listp buffer-or-list
)
1798 (list buffer-or-list
)))
1799 (with-current-buffer buffer
1800 (read-only-mode 1))))
1802 (defun ffap-read-only ()
1803 "Like `ffap', but mark buffer as read-only.
1804 Only intended for interactive use."
1806 (let ((value (call-interactively 'ffap
)))
1807 (unless (or (bufferp value
) (bufferp (car-safe value
)))
1808 (setq value
(current-buffer)))
1809 (ffap--toggle-read-only value
)
1812 (defun ffap-read-only-other-window ()
1813 "Like `ffap', but put buffer in another window and mark as read-only.
1814 Only intended for interactive use."
1816 (let ((value (ffap-other-window)))
1817 (ffap--toggle-read-only value
)
1820 (defun ffap-read-only-other-frame ()
1821 "Like `ffap', but put buffer in another frame and mark as read-only.
1822 Only intended for interactive use."
1824 (let ((value (ffap-other-frame)))
1825 (ffap--toggle-read-only value
)
1828 (defun ffap-alternate-file ()
1829 "Like `ffap' and `find-alternate-file'.
1830 Only intended for interactive use."
1832 (let ((ffap-file-finder 'find-alternate-file
))
1833 (call-interactively 'ffap
)))
1835 (defun ffap-alternate-file-other-window ()
1836 "Like `ffap' and `find-alternate-file-other-window'.
1837 Only intended for interactive use."
1839 (let ((ffap-file-finder 'find-alternate-file-other-window
))
1840 (call-interactively 'ffap
)))
1842 (defun ffap-literally ()
1843 "Like `ffap' and command `find-file-literally'.
1844 Only intended for interactive use."
1846 (let ((ffap-file-finder 'find-file-literally
))
1847 (call-interactively 'ffap
)))
1849 (defalias 'find-file-literally-at-point
'ffap-literally
)
1854 (define-obsolete-function-alias 'ffap-bug
'report-emacs-bug
"23.1")
1855 (define-obsolete-function-alias 'ffap-submit-bug
'report-emacs-bug
"23.1")
1858 ;;; Hooks for Gnus, VM, Rmail:
1860 ;; If you do not like these bindings, write versions with whatever
1861 ;; bindings you would prefer.
1863 (defun ffap-ro-mode-hook ()
1864 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
1865 (local-set-key "\M-l" 'ffap-next
)
1866 (local-set-key "\M-m" 'ffap-menu
))
1868 (defun ffap-gnus-hook ()
1869 "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
1871 (setq-local thing-at-point-default-mail-uri-scheme
"news")
1872 ;; Note "l", "L", "m", "M" are taken:
1873 (local-set-key "\M-l" 'ffap-gnus-next
)
1874 (local-set-key "\M-m" 'ffap-gnus-menu
))
1876 (defvar gnus-summary-buffer
)
1877 (defvar gnus-article-buffer
)
1879 ;; This code is called from gnus.
1880 (declare-function gnus-summary-select-article
"gnus-sum"
1881 (&optional all-headers force pseudo article
))
1883 (declare-function gnus-configure-windows
"gnus-win"
1884 (setting &optional force
))
1886 (defun ffap-gnus-wrapper (form) ; used by both commands below
1887 (and (eq (current-buffer) (get-buffer gnus-summary-buffer
))
1888 (gnus-summary-select-article)) ; get article of current line
1889 ;; Preserve selected buffer, but do not do save-window-excursion,
1890 ;; since we want to see any window created by the form. Temporarily
1891 ;; select the article buffer, so we can see any point movement.
1892 (let ((sb (window-buffer)))
1893 (gnus-configure-windows 'article
)
1894 (pop-to-buffer gnus-article-buffer
)
1896 ;; Skip headers for ffap-gnus-next (which will wrap around)
1897 (if (eq (point) (point-min)) (search-forward "\n\n" nil t
))
1900 (pop-to-buffer sb
))))
1902 (defun ffap-gnus-next ()
1903 "Run `ffap-next' in the gnus article buffer."
1904 (interactive) (ffap-gnus-wrapper '(ffap-next nil t
)))
1906 (defun ffap-gnus-menu ()
1907 "Run `ffap-menu' in the gnus article buffer."
1908 (interactive) (ffap-gnus-wrapper '(ffap-menu)))
1913 (defun dired-at-point (&optional filename
)
1914 "Start Dired, defaulting to file at point. See `ffap'.
1915 If `dired-at-point-require-prefix' is set, the prefix meaning is reversed."
1917 (if (and (called-interactively-p 'interactive
)
1918 (if dired-at-point-require-prefix
1919 (not current-prefix-arg
)
1920 current-prefix-arg
))
1921 (let (current-prefix-arg) ; already interpreted
1922 (call-interactively ffap-directory-finder
))
1923 (or filename
(setq filename
(dired-at-point-prompter)))
1924 (let ((url (ffap-url-p filename
)))
1927 (funcall ffap-url-fetcher url
))
1928 ((and ffap-dired-wildcards
1929 (string-match ffap-dired-wildcards filename
))
1930 (funcall ffap-directory-finder filename
))
1931 ((file-exists-p filename
)
1932 (if (file-directory-p filename
)
1933 (funcall ffap-directory-finder
1934 (expand-file-name filename
))
1935 (funcall ffap-directory-finder
1936 (concat (expand-file-name filename
) "*"))))
1937 ((and (file-writable-p
1938 (or (file-name-directory (directory-file-name filename
))
1940 (y-or-n-p "Directory does not exist, create it? "))
1941 (make-directory filename
)
1942 (funcall ffap-directory-finder filename
))
1944 (signal 'file-missing
(list "Opening directory"
1945 "No such file or directory"
1948 (defun dired-at-point-prompter (&optional guess
)
1949 ;; Does guess and prompt step for find-file-at-point.
1950 ;; Extra complication for the temporary highlighting.
1952 (ffap-read-file-or-url
1954 ((eq ffap-directory-finder
'list-directory
)
1955 "List directory (brief): ")
1956 (ffap-url-regexp "Dired file or URL: ")
1960 (let ((guess (or guess
(ffap-guesser))))
1963 ((ffap-url-p guess
))
1964 ((ffap-file-remote-p guess
)
1967 (setq guess
(abbreviate-file-name
1968 (expand-file-name guess
)))
1969 ;; Interpret local directory as a directory.
1970 (file-directory-p guess
))
1971 (file-name-as-directory guess
))
1972 ;; Get directory component from local files.
1973 ((file-regular-p guess
)
1974 (file-name-directory guess
))
1976 (and guess
(ffap-highlight))))
1977 (ffap-highlight t
)))
1979 ;;; ffap-dired-other-*, ffap-list-directory commands:
1981 (defun ffap-dired-other-window ()
1982 "Like `dired-at-point', but put buffer in another window.
1983 Only intended for interactive use."
1986 (switch-to-buffer-other-window
1987 (save-window-excursion
1988 (setq value
(call-interactively 'dired-at-point
))
1992 (defun ffap-dired-other-frame ()
1993 "Like `dired-at-point', but put buffer in another frame.
1994 Only intended for interactive use."
1996 ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1997 (let* ((win (selected-window))
1998 (wdp (window-dedicated-p win
))
2002 (set-window-dedicated-p win nil
)
2003 (switch-to-buffer-other-frame
2004 (save-window-excursion
2005 (setq value
(call-interactively 'dired-at-point
))
2007 (set-window-dedicated-p win wdp
))
2010 (defun ffap-list-directory ()
2011 "Like `dired-at-point' and `list-directory'.
2012 Only intended for interactive use."
2014 (let ((ffap-directory-finder 'list-directory
))
2015 (call-interactively 'dired-at-point
)))
2018 ;;; Hooks to put in `file-name-at-point-functions':
2021 (defun ffap-guess-file-name-at-point ()
2022 "Try to get a file name at point.
2023 This hook is intended to be put in `file-name-at-point-functions'."
2024 ;; ffap-guesser can signal an error, and we don't want that when,
2025 ;; e.g., the user types M-n at the "C-x C-f" prompt.
2026 (let ((guess (ignore-errors (ffap-guesser))))
2027 (when (stringp guess
)
2028 (let ((url (ffap-url-p guess
)))
2031 (unless (ffap-file-remote-p guess
)
2033 (abbreviate-file-name (expand-file-name guess
))))
2034 (if (file-directory-p guess
)
2035 (file-name-as-directory guess
)
2038 ;;; Offer default global bindings (`ffap-bindings'):
2040 (defvar ffap-bindings
2041 '((global-set-key [S-mouse-3
] 'ffap-at-mouse
)
2042 (global-set-key [C-S-mouse-3
] 'ffap-menu
)
2044 (global-set-key "\C-x\C-f" 'find-file-at-point
)
2045 (global-set-key "\C-x\C-r" 'ffap-read-only
)
2046 (global-set-key "\C-x\C-v" 'ffap-alternate-file
)
2048 (global-set-key "\C-x4f" 'ffap-other-window
)
2049 (global-set-key "\C-x5f" 'ffap-other-frame
)
2050 (global-set-key "\C-x4r" 'ffap-read-only-other-window
)
2051 (global-set-key "\C-x5r" 'ffap-read-only-other-frame
)
2053 (global-set-key "\C-xd" 'dired-at-point
)
2054 (global-set-key "\C-x4d" 'ffap-dired-other-window
)
2055 (global-set-key "\C-x5d" 'ffap-dired-other-frame
)
2056 (global-set-key "\C-x\C-d" 'ffap-list-directory
)
2058 (add-hook 'gnus-summary-mode-hook
'ffap-gnus-hook
)
2059 (add-hook 'gnus-article-mode-hook
'ffap-gnus-hook
)
2060 (add-hook 'vm-mode-hook
'ffap-ro-mode-hook
)
2061 (add-hook 'rmail-mode-hook
'ffap-ro-mode-hook
))
2062 "List of binding forms evaluated by function `ffap-bindings'.
2063 A reasonable ffap installation needs just this one line:
2065 Of course if you do not like these bindings, just roll your own!")
2068 (defun ffap-bindings ()
2069 "Evaluate the forms in variable `ffap-bindings'."
2071 (eval (cons 'progn ffap-bindings
)))
2076 ;;; ffap.el ends here