Switch to recommended form of GPLv3 permissions notice.
[bpt/emacs.git] / lisp / ffap.el
CommitLineData
0f76d837
JL
1;;; ffap.el --- find file (or url) at point
2
e91081eb 3;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004,
409cc4a3 4;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
0f76d837 5
b578f267 6;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
c45f4fd9 7;; Maintainer: FSF
87e2d039 8;; Created: 29 Mar 1993
f5f727f8 9;; Keywords: files, hypermedia, matching, mouse, convenience
3788c735 10;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
213d9a4f
RS
11
12;; This file is part of GNU Emacs.
13
eb3fa2cf 14;; GNU Emacs is free software: you can redistribute it and/or modify
213d9a4f 15;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
16;; the Free Software Foundation, either version 3 of the License, or
17;; (at your option) any later version.
213d9a4f
RS
18
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.
23
24;; You should have received a copy of the GNU General Public License
eb3fa2cf 25;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
213d9a4f 26
213d9a4f 27\f
87e2d039 28;;; Commentary:
213d9a4f 29;;
87e2d039
RS
30;; Command find-file-at-point replaces find-file. With a prefix, it
31;; behaves exactly like find-file. Without a prefix, it first tries
41d34bed 32;; to guess a default file or URL from the text around the point
87e2d039
RS
33;; (`ffap-require-prefix' swaps these behaviors). This is useful for
34;; following references in situations such as mail or news buffers,
35;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
36;; M-x ffap-bug.
213d9a4f 37;;
25050dab 38;; For the default installation, add this line to your .emacs file:
213d9a4f 39;;
87e2d039 40;; (ffap-bindings) ; do default key bindings
213d9a4f 41;;
87e2d039 42;; ffap-bindings makes the following global key bindings:
213d9a4f 43;;
c99310d5
JL
44;; C-x C-f find-file-at-point (abbreviated as ffap)
45;; C-x C-r ffap-read-only
46;; C-x C-v ffap-alternate-file
47;;
48;; C-x d dired-at-point
49;; C-x C-d ffap-list-directory
50;;
51;; C-x 4 f ffap-other-window
52;; C-x 4 r ffap-read-only-other-window
53;; C-x 4 d ffap-dired-other-window
54;;
55;; C-x 5 f ffap-other-frame
56;; C-x 5 r ffap-read-only-other-frame
57;; C-x 5 d ffap-dired-other-frame
58;;
87e2d039 59;; S-mouse-3 ffap-at-mouse
0948761d 60;; C-S-mouse-3 ffap-menu
213d9a4f 61;;
87e2d039
RS
62;; ffap-bindings also adds hooks to make the following local bindings
63;; in vm, gnus, and rmail:
213d9a4f 64;;
0948761d
KH
65;; M-l ffap-next, or ffap-gnus-next in gnus (l == "link")
66;; M-m ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
213d9a4f 67;;
87e2d039
RS
68;; If you do not like these bindings, modify the variable
69;; `ffap-bindings', or write your own.
213d9a4f 70;;
87e2d039
RS
71;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
72;; to load or autoload them before ffap. If you use ff-paths, load it
73;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many
74;; option variables. In particular, if ffap is slow, try these:
213d9a4f 75;;
87e2d039
RS
76;; (setq ffap-alist nil) ; faster, dumber prompting
77;; (setq ffap-machine-p-known 'accept) ; no pinging
41d34bed 78;; (setq ffap-url-regexp nil) ; disable URL features in ffap
c98ddbe5 79;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping
213d9a4f 80;;
3788c735
KH
81;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
82;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
87e2d039 83;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
71296446 84;; the file and URL references within a buffer.
87e2d039 85
0948761d
KH
86\f
87;;; Change Log:
88;;
89;; The History and Contributors moved to ffap.LOG (same ftp site),
90;; which also has some old examples and commentary from ffap 1.5.
91
92\f
87e2d039 93;;; Todo list:
0948761d 94;; * use kpsewhich
95a85681 95;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file
87e2d039 96;; * find file of symbol if TAGS is loaded (like above)
0948761d
KH
97;; * break long menus into multiple panes (like imenu?)
98;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
95a85681 99;; * notice "machine.dom blah blah blah dir/file" (how?)
0948761d 100;; * as w3 becomes standard, rewrite to rely more on its functions
87e2d039
RS
101;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
102;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
0948761d
KH
103;; * handle "$(VAR)" in Makefiles
104;; * use the font-lock machinery
213d9a4f
RS
105
106\f
107;;; Code:
108
109(provide 'ffap)
110
3788c735
KH
111;; Please do not delete this variable, it is checked in bug reports.
112(defconst ffap-version "1.9-fsf <97/06/25 13:21:41 mic>"
113 "The version of ffap: \"Major.Minor-Build <Timestamp>\"")
87e2d039 114
213d9a4f 115
41d34bed
RS
116(defgroup ffap nil
117 "Find file or URL at point."
3788c735 118 :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/")
f5f727f8
DN
119 :group 'matching
120 :group 'convenience)
41d34bed 121
3788c735
KH
122;; The code is organized in pages, separated by formfeed characters.
123;; See the next two pages for standard customization ideas.
124
125\f
126;;; User Variables:
41d34bed 127
0948761d 128(defun ffap-soft-value (name &optional default)
87e2d039
RS
129 "Return value of symbol with NAME, if it is interned.
130Otherwise return nil (or the optional DEFAULT value)."
131 ;; Bug: (ffap-soft-value "nil" 5) --> 5
213d9a4f 132 (let ((sym (intern-soft name)))
0948761d 133 (if (and sym (boundp sym)) (symbol-value sym) default)))
213d9a4f 134
c98ddbe5
RV
135(defcustom ffap-shell-prompt-regexp
136 ;; This used to test for some shell prompts that don't have a space
137 ;; after them. The common root shell prompt (#) is not listed since it
138 ;; also doubles up as a valid URL character.
139 "[$%><]*"
140 "Paths matching this regexp are stripped off the shell prompt
141If nil, ffap doesn't do shell prompt stripping."
142 :type '(choice (const :tag "Disable" nil)
143 (const :tag "Standard" "[$%><]*")
144 regexp)
145 :group 'ffap)
146
41d34bed 147(defcustom ffap-ftp-regexp
0948761d
KH
148 ;; This used to test for ange-ftp or efs being present, but it should be
149 ;; harmless (and simpler) to give it this value unconditionally.
150 "\\`/[^/:]+:"
95a85681
RS
151 "*File names matching this regexp are treated as remote ffap.
152If nil, ffap neither recognizes nor generates such names."
41d34bed 153 :type '(choice (const :tag "Disable" nil)
0948761d 154 (const :tag "Standard" "\\`/[^/:]+:")
41d34bed
RS
155 regexp)
156 :group 'ffap)
157
158(defcustom ffap-url-unwrap-local t
95a85681 159 "*If non-nil, convert `file:' URL to local file name before prompting."
41d34bed
RS
160 :type 'boolean
161 :group 'ffap)
162
163(defcustom ffap-url-unwrap-remote t
95a85681 164 "*If non-nil, convert `ftp:' URL to remote file name before prompting.
41d34bed
RS
165This is ignored if `ffap-ftp-regexp' is nil."
166 :type 'boolean
167 :group 'ffap)
168
0948761d 169(defcustom ffap-ftp-default-user "anonymous"
95a85681 170 "*User name in ftp file names generated by `ffap-host-to-path'.
0948761d
KH
171Note this name may be omitted if it equals the default
172\(either `efs-default-user' or `ange-ftp-default-user'\)."
173 :type 'string
41d34bed 174 :group 'ffap)
213d9a4f 175
41d34bed 176(defcustom ffap-rfs-regexp
213d9a4f
RS
177 ;; Remote file access built into file system? HP rfa or Andrew afs:
178 "\\`/\\(afs\\|net\\)/."
179 ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
95a85681 180 "*Matching file names are treated as remote. Use nil to disable."
41d34bed
RS
181 :type 'regexp
182 :group 'ffap)
213d9a4f
RS
183
184(defvar ffap-url-regexp
185 ;; Could just use `url-nonrelative-link' of w3, if loaded.
186 ;; This regexp is not exhaustive, it just matches common cases.
187 (concat
188 "\\`\\("
189 "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
190 "\\|"
1d34daae 191 "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
213d9a4f
RS
192 "\\)." ; require one more character
193 )
41d34bed 194 "Regexp matching URL's. nil to disable URL features in ffap.")
213d9a4f 195
41d34bed
RS
196(defcustom ffap-foo-at-bar-prefix "mailto"
197 "*Presumed URL prefix type of strings like \"<foo.9z@bar>\".
198Sensible values are nil, \"news\", or \"mailto\"."
0948761d
KH
199 :type '(choice (const "mailto")
200 (const "news")
201 (const :tag "Disable" nil)
202 ;; string -- possible, but not really useful
203 )
41d34bed 204 :group 'ffap)
213d9a4f
RS
205
206\f
0948761d 207;;; Peanut Gallery (More User Variables):
87e2d039 208;;
213d9a4f
RS
209;; Users of ffap occasionally suggest new features. If I consider
210;; those features interesting but not clear winners (a matter of
211;; personal taste) I try to leave options to enable them. Read
87e2d039
RS
212;; through this section for features that you like, put an appropriate
213;; enabler in your .emacs file.
213d9a4f 214
c99310d5 215(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
213d9a4f 216 "*A regexp matching filename wildcard characters, or nil.
c99310d5 217
87e2d039 218If `find-file-at-point' gets a filename matching this pattern,
5b523a77
JL
219and `ffap-pass-wildcards-to-dired' is nil, it passes it on to
220`find-file' with non-nil WILDCARDS argument, which expands
221wildcards and visits multiple files. To visit a file whose name
222contains wildcard characters you can suppress wildcard expansion
223by setting `find-file-wildcards'. If `find-file-at-point' gets a
224filename matching this pattern and `ffap-pass-wildcards-to-dired'
225is non-nil, it passes it on to `dired'.
c99310d5
JL
226
227If `dired-at-point' gets a filename matching this pattern,
228it passes it on to `dired'."
0948761d
KH
229 :type '(choice (const :tag "Disable" nil)
230 (const :tag "Enable" "[*?][^/]*\\'")
231 ;; regexp -- probably not useful
232 )
41d34bed 233 :group 'ffap)
213d9a4f 234
5b523a77
JL
235(defcustom ffap-pass-wildcards-to-dired nil
236 "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired."
237 :type 'boolean
238 :group 'ffap)
239
0948761d 240(defcustom ffap-newfile-prompt nil
87e2d039
RS
241 ;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is
242 ;; better handled by `find-file-not-found-hooks'.
41d34bed
RS
243 "*Whether `find-file-at-point' prompts about a nonexistent file."
244 :type 'boolean
245 :group 'ffap)
213d9a4f 246
41d34bed 247(defcustom ffap-require-prefix nil
87e2d039
RS
248 ;; Suggestion from RHOGEE, 20 Oct 1994.
249 "*If set, reverses the prefix argument to `find-file-at-point'.
250This is nil so neophytes notice ffap. Experts may prefer to disable
41d34bed
RS
251ffap most of the time."
252 :type 'boolean
253 :group 'ffap)
254
255(defcustom ffap-file-finder 'find-file
256 "*The command called by `find-file-at-point' to find a file."
257 :type 'function
258 :group 'ffap)
87e2d039 259(put 'ffap-file-finder 'risky-local-variable t)
213d9a4f 260
c99310d5
JL
261(defcustom ffap-directory-finder 'dired
262 "*The command called by `dired-at-point' to find a directory."
263 :type 'function
264 :group 'ffap)
265(put 'ffap-directory-finder 'risky-local-variable t)
266
41d34bed 267(defcustom ffap-url-fetcher
3788c735
KH
268 (if (fboundp 'browse-url)
269 'browse-url ; rely on browse-url-browser-function
270 'w3-fetch)
87e2d039 271 ;; Remote control references:
213d9a4f
RS
272 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
273 ;; http://home.netscape.com/newsref/std/x-remote.html
87e2d039 274 "*A function of one argument, called by ffap to fetch an URL.
3788c735 275Reasonable choices are `w3-fetch' or a `browse-url-*' function.
ee79ced8 276For a fancy alternative, get `ffap-url.el'."
0948761d 277 :type '(choice (const w3-fetch)
3788c735 278 (const browse-url) ; in recent versions of browse-url
0948761d
KH
279 (const browse-url-netscape)
280 (const browse-url-mosaic)
281 function)
41d34bed 282 :group 'ffap)
213d9a4f
RS
283(put 'ffap-url-fetcher 'risky-local-variable t)
284
285\f
3788c735
KH
286;;; Compatibility:
287;;
516bf0ee
RS
288;; This version of ffap supports only the Emacs it is distributed in.
289;; See the ftp site for a more general version. The following
290;; functions are necessary "leftovers" from the more general version.
3788c735
KH
291
292(defun ffap-mouse-event nil ; current mouse event, or nil
293 (and (listp last-nonmenu-event) last-nonmenu-event))
294(defun ffap-event-buffer (event)
295 (window-buffer (car (event-start event))))
0948761d
KH
296
297\f
298;;; Find Next Thing in buffer (`ffap-next'):
213d9a4f 299;;
87e2d039
RS
300;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since
301;; then, broke it up into ffap-next-guess (noninteractive) and
302;; ffap-next (a command). It now work on files as well as url's.
213d9a4f 303
41d34bed 304(defcustom ffap-next-regexp
213d9a4f
RS
305 ;; If you want ffap-next to find URL's only, try this:
306 ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
307 ;; (concat "\\<" (substring ffap-url-regexp 2))))
308 ;;
309 ;; It pays to put a big fancy regexp here, since ffap-guesser is
310 ;; much more time-consuming than regexp searching:
5362ba53 311 "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
41d34bed
RS
312 "*Regular expression governing movements of `ffap-next'."
313 :type 'regexp
314 :group 'ffap)
213d9a4f 315
c9ae9869
RS
316(defvar ffap-next-guess nil
317 "Last value returned by `ffap-next-guess'.")
318
319(defvar ffap-string-at-point-region '(1 1)
320 "List (BEG END), last region returned by `ffap-string-at-point'.")
321
213d9a4f 322(defun ffap-next-guess (&optional back lim)
41d34bed 323 "Move point to next file or URL, and return it as a string.
87e2d039 324If nothing is found, leave point at limit and return nil.
213d9a4f
RS
325Optional BACK argument makes search backwards.
326Optional LIM argument limits the search.
327Only considers strings that match `ffap-next-regexp'."
328 (or lim (setq lim (if back (point-min) (point-max))))
329 (let (guess)
330 (while (not (or guess (eq (point) lim)))
331 (funcall (if back 're-search-backward 're-search-forward)
332 ffap-next-regexp lim 'move)
333 (setq guess (ffap-guesser)))
334 ;; Go to end, so we do not get same guess twice:
335 (goto-char (nth (if back 0 1) ffap-string-at-point-region))
336 (setq ffap-next-guess guess)))
337
338;;;###autoload
339(defun ffap-next (&optional back wrap)
41d34bed 340 "Search buffer for next file or URL, and run ffap.
213d9a4f
RS
341Optional argument BACK says to search backwards.
342Optional argument WRAP says to try wrapping around if necessary.
343Interactively: use a single prefix to search backwards,
344double prefix to wrap forward, triple to wrap backwards.
87e2d039 345Actual search is done by `ffap-next-guess'."
213d9a4f
RS
346 (interactive
347 (cdr (assq (prefix-numeric-value current-prefix-arg)
348 '((1) (4 t) (16 nil t) (64 t t)))))
349 (let ((pt (point))
350 (guess (ffap-next-guess back)))
351 ;; Try wraparound if necessary:
352 (and (not guess) wrap
353 (goto-char (if back (point-max) (point-min)))
354 (setq guess (ffap-next-guess back pt)))
355 (if guess
356 (progn
357 (sit-for 0) ; display point movement
358 (find-file-at-point (ffap-prompter guess)))
359 (goto-char pt) ; restore point
41d34bed 360 (message "No %sfiles or URL's found"
213d9a4f
RS
361 (if wrap "" "more ")))))
362
363(defun ffap-next-url (&optional back wrap)
87e2d039 364 "Like `ffap-next', but search with `ffap-url-regexp'."
213d9a4f
RS
365 (interactive)
366 (let ((ffap-next-regexp ffap-url-regexp))
367 (if (interactive-p)
368 (call-interactively 'ffap-next)
369 (ffap-next back wrap))))
370
371\f
0948761d 372;;; Machines (`ffap-machine-p'):
213d9a4f
RS
373
374;; I cannot decide a "best" strategy here, so these are variables. In
375;; particular, if `Pinging...' is broken or takes too long on your
376;; machine, try setting these all to accept or reject.
41d34bed 377(defcustom ffap-machine-p-local 'reject ; this happens often
ee79ced8 378 "*What `ffap-machine-p' does with hostnames that have no domain.
88b5c6b3 379Value should be a symbol, one of `ping', `accept', and `reject'."
41d34bed
RS
380 :type '(choice (const ping)
381 (const accept)
382 (const reject))
383 :group 'ffap)
ee79ced8
KH
384(defcustom ffap-machine-p-known 'ping ; `accept' for higher speed
385 "*What `ffap-machine-p' does with hostnames that have a known domain.
386Value should be a symbol, one of `ping', `accept', and `reject'.
387See `mail-extr.el' for the known domains."
41d34bed
RS
388 :type '(choice (const ping)
389 (const accept)
390 (const reject))
391 :group 'ffap)
392(defcustom ffap-machine-p-unknown 'reject
ee79ced8
KH
393 "*What `ffap-machine-p' does with hostnames that have an unknown domain.
394Value should be a symbol, one of `ping', `accept', and `reject'.
395See `mail-extr.el' for the known domains."
41d34bed
RS
396 :type '(choice (const ping)
397 (const accept)
398 (const reject))
399 :group 'ffap)
87e2d039
RS
400
401(defun ffap-what-domain (domain)
402 ;; Like what-domain in mail-extr.el, returns string or nil.
403 (require 'mail-extr)
3788c735
KH
404 (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains")
405 (ffap-soft-value "all-top-level-domains")))) ; XEmacs
406 (and ob (get (intern-soft (downcase domain) ob) 'domain-name))))
87e2d039
RS
407
408(defun ffap-machine-p (host &optional service quiet strategy)
409 "Decide whether HOST is the name of a real, reachable machine.
410Depending on the domain (none, known, or unknown), follow the strategy
411named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
412or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
413Optional SERVICE specifies the port used \(default \"discard\"\).
213d9a4f 414Optional QUIET flag suppresses the \"Pinging...\" message.
87e2d039 415Optional STRATEGY overrides the three variables above.
213d9a4f 416Returned values:
87e2d039
RS
417 t means that HOST answered.
418'accept means the relevant variable told us to accept.
419\"mesg\" means HOST exists, but does not respond for some reason."
420 ;; Try some (Emory local):
421 ;; (ffap-machine-p "ftp" nil nil 'ping)
422 ;; (ffap-machine-p "nonesuch" nil nil 'ping)
423 ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
424 ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
425 ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
426 ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
9b9a4122 427 (if (or (string-match "[^-[:alnum:].]" host) ; Invalid chars (?)
87e2d039 428 (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
213d9a4f
RS
429 nil
430 (let* ((domain
431 (and (string-match "\\.[^.]*$" host)
432 (downcase (substring host (1+ (match-beginning 0))))))
87e2d039
RS
433 (what-domain (if domain (ffap-what-domain domain) "Local")))
434 (or strategy
435 (setq strategy
436 (cond ((not domain) ffap-machine-p-local)
437 ((not what-domain) ffap-machine-p-unknown)
438 (t ffap-machine-p-known))))
213d9a4f
RS
439 (cond
440 ((eq strategy 'accept) 'accept)
441 ((eq strategy 'reject) nil)
e75e894b 442 ((not (fboundp 'open-network-stream)) nil)
213d9a4f
RS
443 ;; assume (eq strategy 'ping)
444 (t
445 (or quiet
87e2d039
RS
446 (if (stringp what-domain)
447 (message "Pinging %s (%s)..." host what-domain)
213d9a4f
RS
448 (message "Pinging %s ..." host)))
449 (condition-case error
450 (progn
451 (delete-process
452 (open-network-stream
453 "ffap-machine-p" nil host (or service "discard")))
454 t)
455 (error
456 (let ((mesg (car (cdr error))))
457 (cond
458 ;; v18:
459 ((string-match "^Unknown host" mesg) nil)
460 ((string-match "not responding$" mesg) mesg)
461 ;; v19:
462 ;; (file-error "connection failed" "permission denied"
463 ;; "nonesuch" "ffap-machine-p")
464 ;; (file-error "connection failed" "host is unreachable"
465 ;; "gopher.house.gov" "ffap-machine-p")
466 ;; (file-error "connection failed" "address already in use"
467 ;; "ftp.uu.net" "ffap-machine-p")
468 ((equal mesg "connection failed")
469 (if (equal (nth 2 error) "permission denied")
470 nil ; host does not exist
87e2d039 471 ;; Other errors mean the host exists:
213d9a4f
RS
472 (nth 2 error)))
473 ;; Could be "Unknown service":
474 (t (signal (car error) (cdr error))))))))))))
475
0948761d
KH
476\f
477;;; Possibly Remote Resources:
478
95a85681 479(defun ffap-replace-file-component (fullname name)
0948761d
KH
480 "In remote FULLNAME, replace path with NAME. May return nil."
481 ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
482 (let (found)
dabec3c9 483 (mapc
0948761d
KH
484 (function (lambda (sym) (and (fboundp sym) (setq found sym))))
485 '(
486 efs-replace-path-component
487 ange-ftp-replace-path-component
488 ange-ftp-replace-name-component
489 ))
490 (and found
95a85681 491 (fset 'ffap-replace-file-component found)
0948761d 492 (funcall found fullname name))))
95a85681 493;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new")
0948761d 494
3788c735 495(defun ffap-file-suffix (file)
ee79ced8 496 "Return trailing `.foo' suffix of FILE, or nil if none."
3788c735
KH
497 (let ((pos (string-match "\\.[^./]*\\'" file)))
498 (and pos (substring file pos nil))))
499
500(defvar ffap-compression-suffixes '(".gz" ".Z") ; .z is mostly dead
501 "List of suffixes tried by `ffap-file-exists-string'.")
502
503(defun ffap-file-exists-string (file &optional nomodify)
504 ;; Early jka-compr versions modified file-exists-p to return the
505 ;; filename, maybe modified by adding a suffix like ".gz". That
506 ;; broke the interface of file-exists-p, so it was later dropped.
507 ;; Here we document and simulate the old behavior.
ee79ced8 508 "Return FILE (maybe modified) if the file exists, else nil.
3788c735
KH
509When using jka-compr (a.k.a. `auto-compression-mode'), the returned
510name may have a suffix added from `ffap-compression-suffixes'.
511The optional NOMODIFY argument suppresses the extra search."
512 (cond
513 ((not file) nil) ; quietly reject nil
514 ((file-exists-p file) file) ; try unmodified first
515 ;; three reasons to suppress search:
516 (nomodify nil)
517 ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil)
518 ((member (ffap-file-suffix file) ffap-compression-suffixes) nil)
519 (t ; ok, do the search
520 (let ((list ffap-compression-suffixes) try ret)
521 (while list
522 (if (file-exists-p (setq try (concat file (car list))))
523 (setq ret try list nil)
524 (setq list (cdr list))))
525 ret))))
0948761d 526
213d9a4f 527(defun ffap-file-remote-p (filename)
ee79ced8 528 "If FILENAME looks remote, return it (maybe slightly improved)."
213d9a4f 529 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
95a85681 530 ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir")
87e2d039 531 ;; (ffap-file-remote-p "/ffap.el:80")
213d9a4f
RS
532 (or (and ffap-ftp-regexp
533 (string-match ffap-ftp-regexp filename)
95a85681
RS
534 ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing
535 ;; practice of advertising ftp files as "host.dom://filename".
213d9a4f 536 (if (string-match "//" filename)
87e2d039
RS
537 ;; (replace-match "/" nil nil filename)
538 (concat (substring filename 0 (1+ (match-beginning 0)))
539 (substring filename (match-end 0)))
213d9a4f
RS
540 filename))
541 (and ffap-rfs-regexp
542 (string-match ffap-rfs-regexp filename)
543 filename)))
544
545(defun ffap-machine-at-point nil
87e2d039
RS
546 "Return machine name at point if it exists, or nil."
547 (let ((mach (ffap-string-at-point 'machine)))
213d9a4f
RS
548 (and (ffap-machine-p mach) mach)))
549
95a85681 550(defsubst ffap-host-to-filename (host)
0948761d 551 "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
87e2d039 552Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
0948761d
KH
553 (if (equal host "localhost")
554 ""
555 (let ((user ffap-ftp-default-user))
556 ;; Avoid including the user if it is same as default:
557 (if (or (equal user (ffap-soft-value "ange-ftp-default-user"))
558 (equal user (ffap-soft-value "efs-default-user")))
559 (setq user nil))
560 (concat "/" user (and user "@") host ":"))))
87e2d039 561
213d9a4f 562(defun ffap-fixup-machine (mach)
95a85681 563 ;; Convert a hostname into an url, an ftp file name, or nil.
213d9a4f
RS
564 (cond
565 ((not (and ffap-url-regexp (stringp mach))) nil)
87e2d039 566 ;; gopher.well.com
213d9a4f
RS
567 ((string-match "\\`gopher[-.]" mach) ; or "info"?
568 (concat "gopher://" mach "/"))
87e2d039 569 ;; www.ncsa.uiuc.edu
213d9a4f
RS
570 ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
571 (concat "http://" mach "/"))
572 ;; More cases? Maybe "telnet:" for archie?
95a85681 573 (ffap-ftp-regexp (ffap-host-to-filename mach))
213d9a4f
RS
574 ))
575
5362ba53 576(defvar ffap-newsgroup-regexp "^[[:lower:]]+\\.[-+[:lower:]_0-9.]+$"
c9ae9869
RS
577 "Strings not matching this fail `ffap-newsgroup-p'.")
578(defvar ffap-newsgroup-heads ; entirely inadequate
579 '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
580 "Used by `ffap-newsgroup-p' if gnus is not running.")
581
213d9a4f
RS
582(defun ffap-newsgroup-p (string)
583 "Return STRING if it looks like a newsgroup name, else nil."
584 (and
585 (string-match ffap-newsgroup-regexp string)
586 (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb))
587 (heads ffap-newsgroup-heads)
588 htb ret)
589 (while htbs
590 (setq htb (car htbs) htbs (cdr htbs))
591 (condition-case nil
592 (progn
593 ;; errs: htb symbol may be unbound, or not a hash-table.
594 ;; gnus-gethash is just a macro for intern-soft.
001f5583
RS
595 (and (symbol-value htb)
596 (intern-soft string (symbol-value htb))
213d9a4f 597 (setq ret string htbs nil))
87e2d039 598 ;; If we made it this far, gnus is running, so ignore "heads":
213d9a4f
RS
599 (setq heads nil))
600 (error nil)))
601 (or ret (not heads)
5362ba53 602 (let ((head (string-match "\\`\\([[:lower:]]+\\)\\." string)))
213d9a4f
RS
603 (and head (setq head (substring string 0 (match-end 1)))
604 (member head heads)
605 (setq ret string))))
87e2d039 606 ;; Is there ever a need to modify string as a newsgroup name?
213d9a4f 607 ret)))
213d9a4f 608
87e2d039
RS
609(defsubst ffap-url-p (string)
610 "If STRING looks like an url, return it (maybe improved), else nil."
213d9a4f
RS
611 (let ((case-fold-search t))
612 (and ffap-url-regexp (string-match ffap-url-regexp string)
613 ;; I lied, no improvement:
614 string)))
615
87e2d039
RS
616;; Broke these out of ffap-fixup-url, for use of ffap-url package.
617(defsubst ffap-url-unwrap-local (url)
618 "Return URL as a local file, or nil. Ignores `ffap-url-regexp'."
213d9a4f
RS
619 (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
620 (substring url (1+ (match-end 1)))))
87e2d039
RS
621(defsubst ffap-url-unwrap-remote (url)
622 "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'."
213d9a4f
RS
623 (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
624 (concat
95a85681 625 (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
213d9a4f 626 (substring url (match-beginning 3) (match-end 3)))))
87e2d039 627;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
213d9a4f
RS
628
629(defun ffap-fixup-url (url)
87e2d039 630 "Clean up URL and return it, maybe as a file name."
213d9a4f
RS
631 (cond
632 ((not (stringp url)) nil)
633 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
634 ((and ffap-url-unwrap-remote ffap-ftp-regexp
635 (ffap-url-unwrap-remote url)))
3788c735
KH
636 ((fboundp 'url-normalize-url) ; may autoload url (part of w3)
637 (url-normalize-url url))
638 (url)))
213d9a4f
RS
639
640\f
95a85681 641;;; File Name Handling:
213d9a4f 642;;
0948761d 643;; The upcoming ffap-alist actions need various utilities to prepare
95a85681 644;; and search directories. Too many features here.
0948761d
KH
645
646;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
647;; (defun ffap-splice (func inlist)
648;; "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
649;; (let* ((head (cons 17 nil)) (last head))
650;; (while inlist
651;; (setcdr last (funcall func (car inlist)))
652;; (setq last (ffap-last last) inlist (cdr inlist)))
653;; (cdr head)))
213d9a4f
RS
654
655(defun ffap-list-env (env &optional empty)
0948761d
KH
656 "Return a list of strings parsed from environment variable ENV.
657Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
658also is substituted for the first empty-string component, if there is one.
659Uses `path-separator' to separate the path into substrings."
660 ;; We cannot use parse-colon-path (files.el), since it kills
661 ;; "//" entries using file-name-as-directory.
662 ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
663 ;; in ff-paths and bib-cite. The EMPTY arg may help mimic kpathsea.
213d9a4f
RS
664 (if (or empty (getenv env)) ; should return something
665 (let ((start 0) match dir ret)
87e2d039 666 (setq env (concat (getenv env) path-separator))
8c1001f6 667 (while (setq match (string-match path-separator env start))
213d9a4f
RS
668 (setq dir (substring env start match) start (1+ match))
669 ;;(and (file-directory-p dir) (not (member dir ret)) ...)
670 (setq ret (cons dir ret)))
671 (setq ret (nreverse ret))
672 (and empty (setq match (member "" ret))
0948761d 673 (progn ; allow string or list here
213d9a4f
RS
674 (setcdr match (append (cdr-safe empty) (cdr match)))
675 (setcar match (or (car-safe empty) empty))))
676 ret)))
677
678(defun ffap-reduce-path (path)
87e2d039 679 "Remove duplicates and non-directories from PATH list."
213d9a4f
RS
680 (let (ret tem)
681 (while path
682 (setq tem path path (cdr path))
87e2d039 683 (if (equal (car tem) ".") (setcar tem ""))
213d9a4f
RS
684 (or (member (car tem) ret)
685 (not (file-directory-p (car tem)))
686 (progn (setcdr tem ret) (setq ret tem))))
687 (nreverse ret)))
688
0948761d
KH
689(defun ffap-all-subdirs (dir &optional depth)
690 "Return list all subdirectories under DIR, starting with itself.
691Directories beginning with \".\" are ignored, and directory symlinks
692are listed but never searched (to avoid loops).
693Optional DEPTH limits search depth."
694 (and (file-exists-p dir)
695 (ffap-all-subdirs-loop (expand-file-name dir) (or depth -1))))
696
697(defun ffap-all-subdirs-loop (dir depth) ; internal
698 (setq depth (1- depth))
699 (cons dir
700 (and (not (eq depth -1))
701 (apply 'nconc
702 (mapcar
703 (function
704 (lambda (d)
705 (cond
706 ((not (file-directory-p d)) nil)
707 ((file-symlink-p d) (list d))
708 (t (ffap-all-subdirs-loop d depth)))))
709 (directory-files dir t "\\`[^.]")
710 )))))
711
712(defvar ffap-kpathsea-depth 1
713 "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
714Set to 0 to avoid all searching, or nil for no limit.")
715
716(defun ffap-kpathsea-expand-path (path)
717 "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs.
718The subdirs begin with the original directory, and the depth of the
719search is bounded by `ffap-kpathsea-depth'. This is intended to mimic
720kpathsea, a library used by some versions of TeX."
721 (apply 'nconc
722 (mapcar
723 (function
724 (lambda (dir)
725 (if (string-match "[^/]//\\'" dir)
726 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
727 (list dir))))
728 path)))
729
3788c735 730(defun ffap-locate-file (file &optional nosuffix path dir-ok)
516bf0ee 731 ;; The current version of locate-library could almost replace this,
0f76d837 732 ;; except it does not let us override the suffix list. The
3788c735 733 ;; compression-suffixes search moved to ffap-file-exists-string.
0948761d
KH
734 "A generic path-searching function, mimics `load' by default.
735Returns path to file that \(load FILE\) would load, or nil.
736Optional NOSUFFIX, if nil or t, is like the fourth argument
737for load: whether to try the suffixes (\".elc\" \".el\" \"\").
738If a nonempty list, it is a list of suffixes to try instead.
3788c735
KH
739Optional PATH is a list of directories instead of `load-path'.
740Optional DIR-OK means that returning a directory is allowed,
741DIR-OK is already implicit if FILE looks like a directory.
742
743This uses ffap-file-exists-string, which may try adding suffixes from
744`ffap-compression-suffixes'."
0948761d 745 (or path (setq path load-path))
3788c735 746 (or dir-ok (setq dir-ok (equal "" (file-name-nondirectory file))))
0948761d
KH
747 (if (file-name-absolute-p file)
748 (setq path (list (file-name-directory file))
749 file (file-name-nondirectory file)))
750 (let ((suffixes-to-try
751 (cond
752 ((consp nosuffix) nosuffix)
753 (nosuffix '(""))
3788c735
KH
754 (t '(".elc" ".el" ""))))
755 suffixes try found)
756 (while path
757 (setq suffixes suffixes-to-try)
758 (while suffixes
759 (setq try (ffap-file-exists-string
760 (expand-file-name
761 (concat file (car suffixes)) (car path))))
762 (if (and try (or dir-ok (not (file-directory-p try))))
763 (setq found try suffixes nil path nil)
764 (setq suffixes (cdr suffixes))))
765 (setq path (cdr path)))
766 found))
0948761d
KH
767
768\f
769;;; Action List (`ffap-alist'):
770;;
771;; These search actions depend on the major-mode or regexps matching
772;; the current name. The little functions and their variables are
773;; deferred to the next section, at some loss of "code locality". A
774;; good example of featuritis. Trim this list for speed.
213d9a4f 775
213d9a4f 776(defvar ffap-alist
c9ae9869 777 '(
0948761d
KH
778 ("" . ffap-completable) ; completion, slow on some systems
779 ("\\.info\\'" . ffap-info) ; gzip.info
780 ("\\`info/" . ffap-info-2) ; info/emacs
5362ba53 781 ("\\`[-[:lower:]]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses]
0948761d
KH
782 ("\\.elc?\\'" . ffap-el) ; simple.el, simple.elc
783 (emacs-lisp-mode . ffap-el-mode) ; rmail, gnus, simple, custom
3788c735 784 ;; (lisp-interaction-mode . ffap-el-mode) ; maybe
0948761d
KH
785 (finder-mode . ffap-el-mode) ; type {C-h p} and try it
786 (help-mode . ffap-el-mode) ; maybe useful
787 (c++-mode . ffap-c-mode) ; search ffap-c-path
788 (cc-mode . ffap-c-mode) ; same
789 ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h
790 (fortran-mode . ffap-fortran-mode) ; FORTRAN requested by MDB
791 ("\\.[fF]\\'" . ffap-fortran-mode)
792 (tex-mode . ffap-tex-mode) ; search ffap-tex-path
793 (latex-mode . ffap-latex-mode) ; similar
c9ae9869 794 ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex)
0948761d
KH
795 ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path
796 ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile
797 ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z|
d4f7fdc6
GM
798 ;; This uses to have a blank, but ffap-string-at-point doesn't
799 ;; handle blanks.
800 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html
801 ("^[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $
0948761d
KH
802 . ffap-rfc) ; "100% RFC2100 compliant"
803 (dired-mode . ffap-dired) ; maybe in a subdirectory
804 )
87e2d039
RS
805 "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
806If string NAME at point (maybe \"\") is not a file or url, these pairs
807specify actions to try creating such a string. A pair matches if either
808 KEY is a symbol, and it equals `major-mode', or
809 KEY is a string, it should matches NAME as a regexp.
810On a match, \(FUNCTION NAME\) is called and should return a file, an
811url, or nil. If nil, search the alist for further matches.")
812
213d9a4f 813(put 'ffap-alist 'risky-local-variable t)
0948761d 814
3788c735
KH
815;; Example `ffap-alist' modifications:
816;;
817;; (setq ffap-alist ; remove a feature in `ffap-alist'
818;; (delete (assoc 'c-mode ffap-alist) ffap-alist))
819;;
820;; (setq ffap-alist ; add something to `ffap-alist'
821;; (cons
822;; (cons "^YSN[0-9]+$"
823;; (defun ffap-ysn (name)
824;; (concat
825;; "http://www.physics.uiuc.edu/"
826;; "ysn/httpd/htdocs/ysnarchive/issuefiles/"
827;; (substring name 3) ".html")))
828;; ffap-alist))
829
c9ae9869 830\f
0948761d
KH
831;;; Action Definitions:
832;;
833;; Define various default members of `ffap-alist'.
834
835(defun ffap-completable (name)
836 (let* ((dir (or (file-name-directory name) default-directory))
837 (cmp (file-name-completion (file-name-nondirectory name) dir)))
838 (and cmp (concat dir cmp))))
839
840(defun ffap-home (name) (ffap-locate-file name t '("~")))
c9ae9869
RS
841
842(defun ffap-info (name)
0948761d 843 (ffap-locate-file
c9ae9869
RS
844 name '("" ".info")
845 (or (ffap-soft-value "Info-directory-list")
846 (ffap-soft-value "Info-default-directory-list")
0948761d 847 )))
c9ae9869
RS
848
849(defun ffap-info-2 (name) (ffap-info (substring name 5)))
850
c9ae9869 851(defun ffap-info-3 (name)
0948761d 852 ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
c9ae9869
RS
853 (and (equal (ffap-string-around) "()") (ffap-info name)))
854
0948761d 855(defun ffap-el (name) (ffap-locate-file name t))
c9ae9869
RS
856
857(defun ffap-el-mode (name)
0948761d
KH
858 ;; If name == "foo.el" we will skip it, since ffap-el already
859 ;; searched for it once. (This assumes the default ffap-alist.)
c9ae9869 860 (and (not (string-match "\\.el\\'" name))
0948761d
KH
861 (ffap-locate-file name '(".el"))))
862
863(defvar ffap-c-path
864 ;; Need smarter defaults here! Suggestions welcome.
865 '("/usr/include" "/usr/local/include"))
866(defun ffap-c-mode (name)
867 (ffap-locate-file name t ffap-c-path))
868
869(defvar ffap-fortran-path '("../include" "/usr/include"))
870
871(defun ffap-fortran-mode (name)
872 (ffap-locate-file name t ffap-fortran-path))
c9ae9869 873
c9ae9869
RS
874(defvar ffap-tex-path
875 t ; delayed initialization
876 "Path where `ffap-tex-mode' looks for tex files.
877If t, `ffap-tex-init' will initialize this when needed.")
213d9a4f 878
c9ae9869
RS
879(defun ffap-tex-init nil
880 ;; Compute ffap-tex-path if it is now t.
881 (and (eq t ffap-tex-path)
0948761d 882 ;; this may be slow, so say something
c9ae9869
RS
883 (message "Initializing ffap-tex-path ...")
884 (setq ffap-tex-path
885 (ffap-reduce-path
0948761d
KH
886 (cons
887 "."
888 (ffap-kpathsea-expand-path
889 (append
890 (ffap-list-env "TEXINPUTS")
891 ;; (ffap-list-env "BIBINPUTS")
892 (ffap-soft-value
893 "TeX-macro-global" ; AUCTeX
894 '("/usr/local/lib/tex/macros"
895 "/usr/local/lib/tex/inputs")))))))))
c9ae9869
RS
896
897(defun ffap-tex-mode (name)
898 (ffap-tex-init)
0948761d 899 (ffap-locate-file name '(".tex" "") ffap-tex-path))
c9ae9869
RS
900
901(defun ffap-latex-mode (name)
902 (ffap-tex-init)
0948761d
KH
903 ;; only rare need for ""
904 (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
c9ae9869
RS
905
906(defun ffap-tex (name)
907 (ffap-tex-init)
0948761d
KH
908 (ffap-locate-file name t ffap-tex-path))
909
910(defvar ffap-bib-path
911 (ffap-list-env "BIBINPUTS"
912 (ffap-reduce-path
913 '(
914 ;; a few wild guesses, need better
915 "/usr/local/lib/tex/macros/bib" ; Solaris?
916 "/usr/lib/texmf/bibtex/bib" ; Linux?
917 ))))
c9ae9869
RS
918
919(defun ffap-bib (name)
0948761d 920 (ffap-locate-file name t ffap-bib-path))
c9ae9869
RS
921
922(defun ffap-dired (name)
984ddcbc 923 (let ((pt (point)) try)
c9ae9869
RS
924 (save-excursion
925 (and (progn
926 (beginning-of-line)
927 (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
928 (re-search-backward "^ *$" nil t)
929 (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t)
930 (file-exists-p
931 (setq try
932 (expand-file-name
933 name
934 (buffer-substring
935 (match-beginning 1) (match-end 1)))))
936 try))))
937
938;; Maybe a "Lisp Code Directory" reference:
939(defun ffap-lcd (name)
940 (and
941 (or
942 ;; lisp-dir-apropos output buffer:
943 (string-match "Lisp Code Dir" (buffer-name))
944 ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
945 ;; or maybe the holy LCD-Datafile itself:
946 (member (ffap-string-around) '("||" "|\n")))
947 (concat
948 ;; lispdir.el may not be loaded yet:
95a85681 949 (ffap-host-to-filename
c9ae9869
RS
950 (ffap-soft-value "elisp-archive-host"
951 "archive.cis.ohio-state.edu"))
952 (file-name-as-directory
953 (ffap-soft-value "elisp-archive-directory"
954 "/pub/gnu/emacs/elisp-archive/"))
955 (substring name 2))))
956
8a798137
GM
957(defcustom ffap-rfc-directories nil
958 "A list of directories to look for RFC files.
959If a given RFC isn't in these then `ffap-rfc-path' is offered."
960 :type '(repeat directory)
0a66ac10 961 :version "23.1"
8a798137
GM
962 :group 'ffap)
963
c9ae9869 964(defvar ffap-rfc-path
7b8e334c 965 (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt"))
c9ae9869
RS
966
967(defun ffap-rfc (name)
8a798137
GM
968 (let ((num (match-string 1 name)))
969 (or (ffap-locate-file (format "rfc%s.txt" num) t ffap-rfc-directories)
970 (format ffap-rfc-path num))))
0948761d 971
213d9a4f
RS
972\f
973;;; At-Point Functions:
974
975(defvar ffap-string-at-point-mode-alist
976 '(
87e2d039 977 ;; The default, used when the `major-mode' is not found.
213d9a4f
RS
978 ;; Slightly controversial decisions:
979 ;; * strip trailing "@" and ":"
980 ;; * no commas (good for latex)
d65fc712 981 (file "--:\\\\$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:")
87e2d039 982 ;; An url, or maybe a email/news message-id:
5362ba53 983 (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?")
87e2d039 984 ;; Find a string that does *not* contain a colon:
5362ba53 985 (nocolon "--9$+<>@-Z_[:lower:]~" "<@" "@>;.,!?")
87e2d039 986 ;; A machine:
5362ba53 987 (machine "-[:alnum:]." "" ".")
87e2d039 988 ;; Mathematica paths: allow backquotes
5362ba53 989 (math-mode ",-:$+<>@-Z_[:lower:]~`" "<" "@>;.,!?`:")
213d9a4f 990 )
87e2d039 991 "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
ee79ced8
KH
992possibly a major-mode name, or one of the symbol
993`file', `url', `machine', and `nocolon'.
87e2d039
RS
994`ffap-string-at-point' uses the data fields as follows:
9951. find a maximal string of CHARS around point,
9962. strip BEG chars before point from the beginning,
9973. Strip END chars after point from the end.")
213d9a4f 998
213d9a4f
RS
999(defvar ffap-string-at-point nil
1000 ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
87e2d039
RS
1001 "Last string returned by `ffap-string-at-point'.")
1002
1003(defun ffap-string-at-point (&optional mode)
1004 "Return a string of characters from around point.
ee79ced8 1005MODE (defaults to value of `major-mode') is a symbol used to look up string
87e2d039 1006syntax parameters in `ffap-string-at-point-mode-alist'.
ee79ced8 1007If MODE is not found, we use `file' instead of MODE.
0f76d837 1008If the region is active, return a string from the region.
87e2d039
RS
1009Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
1010 (let* ((args
1011 (cdr
1012 (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
1013 (assq 'file ffap-string-at-point-mode-alist))))
1014 (pt (point))
1015 (str
0f76d837
JL
1016 (if (and transient-mark-mode mark-active)
1017 (buffer-substring
1018 (setcar ffap-string-at-point-region (region-beginning))
1019 (setcar (cdr ffap-string-at-point-region) (region-end)))
1020 (buffer-substring
1021 (save-excursion
1022 (skip-chars-backward (car args))
1023 (skip-chars-forward (nth 1 args) pt)
1024 (setcar ffap-string-at-point-region (point)))
1025 (save-excursion
1026 (skip-chars-forward (car args))
1027 (skip-chars-backward (nth 2 args) pt)
1028 (setcar (cdr ffap-string-at-point-region) (point)))))))
0948761d 1029 (set-text-properties 0 (length str) nil str)
87e2d039 1030 (setq ffap-string-at-point str)))
213d9a4f
RS
1031
1032(defun ffap-string-around nil
1033 ;; Sometimes useful to decide how to treat a string.
87e2d039
RS
1034 "Return string of two chars around last `ffap-string-at-point'.
1035Assumes the buffer has not changed."
213d9a4f
RS
1036 (save-excursion
1037 (format "%c%c"
1038 (progn
1039 (goto-char (car ffap-string-at-point-region))
1040 (preceding-char)) ; maybe 0
1041 (progn
1042 (goto-char (nth 1 ffap-string-at-point-region))
1043 (following-char)) ; maybe 0
1044 )))
1045
87e2d039
RS
1046(defun ffap-copy-string-as-kill (&optional mode)
1047 ;; Requested by MCOOK. Useful?
1048 "Call `ffap-string-at-point', and copy result to `kill-ring'."
1049 (interactive)
1050 (let ((str (ffap-string-at-point mode)))
1051 (if (equal "" str)
1052 (message "No string found around point.")
1053 (kill-new str)
1054 ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
1055 (message "Copied to kill ring: %s" str))))
1056
36b5be6b 1057;; External.
eb22a8c3 1058(declare-function w3-view-this-url "ext:w3" (&optional no-show))
36b5be6b 1059
213d9a4f 1060(defun ffap-url-at-point nil
87e2d039
RS
1061 "Return url from around point if it exists, or nil."
1062 ;; Could use w3's url-get-url-at-point instead. Both handle "URL:",
1063 ;; ignore non-relative links, trim punctuation. The other will
1064 ;; actually look back if point is in whitespace, but I would rather
0948761d 1065 ;; ffap be less aggressive in such situations.
213d9a4f
RS
1066 (and
1067 ffap-url-regexp
1068 (or
0948761d
KH
1069 ;; In a w3 buffer button?
1070 (and (eq major-mode 'w3-mode)
1071 ;; interface recommended by wmperry:
1072 (w3-view-this-url t))
213d9a4f 1073 ;; Is there a reason not to strip trailing colon?
87e2d039 1074 (let ((name (ffap-string-at-point 'url)))
213d9a4f
RS
1075 (cond
1076 ((string-match "^url:" name) (setq name (substring name 4)))
5362ba53 1077 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
213d9a4f 1078 ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
0948761d
KH
1079 ;; Without "<>" it must be "mailto". Otherwise could be
1080 ;; either, so consult `ffap-foo-at-bar-prefix'.
213d9a4f 1081 (let ((prefix (if (and (equal (ffap-string-around) "<>")
0948761d 1082 ;; Expect some odd characters:
213d9a4f
RS
1083 (string-match "[$.0-9].*[$.0-9].*@" name))
1084 ;; Could be news:
87e2d039 1085 ffap-foo-at-bar-prefix
213d9a4f
RS
1086 "mailto")))
1087 (and prefix (setq name (concat prefix ":" name))))))
1088 ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
5362ba53 1089 ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
213d9a4f
RS
1090 (equal (ffap-string-around) "<>")
1091 ;; (ffap-user-p name):
1092 (not (string-match "~" (expand-file-name (concat "~" name))))
1093 )
1094 (setq name (concat "mailto:" name)))
1095 )
1096 (and (ffap-url-p name) name)
1097 ))))
1098
1099(defvar ffap-gopher-regexp
1100 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
1101 "Regexp Matching a line in a gopher bookmark (maybe indented).
87e2d039 1102The two subexpressions are the KEY and VALUE.")
213d9a4f
RS
1103
1104(defun ffap-gopher-at-point nil
1105 "If point is inside a gopher bookmark block, return its url."
87e2d039 1106 ;; `gopher-parse-bookmark' from gopher.el is not so robust
213d9a4f
RS
1107 (save-excursion
1108 (beginning-of-line)
1109 (if (looking-at ffap-gopher-regexp)
1110 (progn
1111 (while (and (looking-at ffap-gopher-regexp) (not (bobp)))
1112 (forward-line -1))
1113 (or (looking-at ffap-gopher-regexp) (forward-line 1))
1114 (let ((type "1") name path host (port "70"))
1115 (while (looking-at ffap-gopher-regexp)
1116 (let ((var (intern
1117 (downcase
1118 (buffer-substring (match-beginning 1)
1119 (match-end 1)))))
1120 (val (buffer-substring (match-beginning 2)
1121 (match-end 2))))
1122 (set var val)
1123 (forward-line 1)))
1124 (if (and path (string-match "^ftp:.*@" path))
1125 (concat "ftp://"
1126 (substring path 4 (1- (match-end 0)))
1127 (substring path (match-end 0)))
1128 (and (= (length type) 1)
1129 host;; (ffap-machine-p host)
1130 (concat "gopher://" host
1131 (if (equal port "70") "" (concat ":" port))
1132 "/" type path))))))))
1133
1134(defvar ffap-ftp-sans-slash-regexp
1135 (and
1136 ffap-ftp-regexp
87e2d039 1137 ;; Note: by now, we know it is not an url.
213d9a4f
RS
1138 ;; Icky regexp avoids: default: 123: foo::bar cs:pub
1139 ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
213d9a4f 1140 "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
95a85681 1141 "Strings matching this are coerced to ftp file names by ffap.
213d9a4f
RS
1142That is, ffap just prepends \"/\". Set to nil to disable.")
1143
1144(defun ffap-file-at-point nil
1145 "Return filename from around point if it exists, or nil.
1146Existence test is skipped for names that look remote.
1147If the filename is not obvious, it also tries `ffap-alist',
87e2d039
RS
1148which may actually result in an url rather than a filename."
1149 ;; Note: this function does not need to look for url's, just
213d9a4f 1150 ;; filenames. On the other hand, it is responsible for converting
95a85681 1151 ;; a pseudo-url "site.com://dir" to an ftp file name
213d9a4f
RS
1152 (let* ((case-fold-search t) ; url prefixes are case-insensitive
1153 (data (match-data))
87e2d039 1154 (string (ffap-string-at-point)) ; uses mode alist
213d9a4f 1155 (name
87e2d039
RS
1156 (or (condition-case nil
1157 (and (not (string-match "//" string)) ; foo.com://bar
1158 (substitute-in-file-name string))
1159 (error nil))
1160 string))
213d9a4f 1161 (abs (file-name-absolute-p name))
d35829ff
GM
1162 (default-directory default-directory)
1163 (oname name))
213d9a4f
RS
1164 (unwind-protect
1165 (cond
c99310d5
JL
1166 ;; Immediate rejects (/ and // and /* are too common in C/C++):
1167 ((member name '("" "/" "//" "/*" ".")) nil)
8005ea3f
RS
1168 ;; Immediately test local filenames. If default-directory is
1169 ;; remote, you probably already have a connection.
1170 ((and (not abs) (ffap-file-exists-string name)))
1171 ;; Try stripping off line numbers; good for compilation/grep output.
1172 ((and (not abs) (string-match ":[0-9]" name)
1173 (ffap-file-exists-string (substring name 0 (match-beginning 0)))))
c98ddbe5
RV
1174 ;; Try stripping off prominent (non-root - #) shell prompts
1175 ;; if the ffap-shell-prompt-regexp is non-nil.
1176 ((and ffap-shell-prompt-regexp
1177 (not abs) (string-match ffap-shell-prompt-regexp name)
1178 (ffap-file-exists-string (substring name (match-end 0)))))
213d9a4f 1179 ;; Accept remote names without actual checking (too slow):
d35829ff 1180 ((and abs (ffap-file-remote-p name)))
213d9a4f
RS
1181 ;; Ok, not remote, try the existence test even if it is absolute:
1182 ((and abs (ffap-file-exists-string name)))
87e2d039
RS
1183 ;; If it contains a colon, get rid of it (and return if exists)
1184 ((and (string-match path-separator name)
1185 (setq name (ffap-string-at-point 'nocolon))
1186 (ffap-file-exists-string name)))
213d9a4f
RS
1187 ;; File does not exist, try the alist:
1188 ((let ((alist ffap-alist) tem try case-fold-search)
1189 (while (and alist (not try))
1190 (setq tem (car alist) alist (cdr alist))
1191 (if (or (eq major-mode (car tem))
1192 (and (stringp (car tem))
1193 (string-match (car tem) name)))
0948761d
KH
1194 (and (setq try
1195 (condition-case nil
1196 (funcall (cdr tem) name)
1197 (error nil)))
213d9a4f
RS
1198 (setq try (or
1199 (ffap-url-p try) ; not a file!
1200 (ffap-file-remote-p try)
1201 (ffap-file-exists-string try))))))
1202 try))
d35829ff
GM
1203 ;; Try adding a leading "/" (common omission in ftp file names).
1204 ;; Note that this uses oname, which still has any colon part.
1205 ;; This should have a lower priority than the alist stuff,
1206 ;; else it matches things like "ffap.el:1234:56:Warning".
1207 ((and (not abs)
1208 ffap-ftp-sans-slash-regexp
1209 (string-match ffap-ftp-sans-slash-regexp oname)
1210 (ffap-file-remote-p (concat "/" oname))))
213d9a4f
RS
1211 ;; Alist failed? Try to guess an active remote connection
1212 ;; from buffer variables, and try once more, both as an
95a85681 1213 ;; absolute and relative file name on that remote host.
213d9a4f
RS
1214 ((let* (ffap-rfs-regexp ; suppress
1215 (remote-dir
1216 (cond
1217 ((ffap-file-remote-p default-directory))
1218 ((and (eq major-mode 'internal-ange-ftp-mode)
1219 (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$"
1220 (buffer-name)))
1221 (concat "/" (substring (buffer-name) 5 -1) ":"))
1222 ;; This is too often a bad idea:
1223 ;;((and (eq major-mode 'w3-mode)
1224 ;; (stringp url-current-server))
1225 ;; (host-to-ange-path url-current-server))
1226 )))
1227 (and remote-dir
1228 (or
1229 (and (string-match "\\`\\(/?~?ftp\\)/" name)
1230 (ffap-file-exists-string
95a85681 1231 (ffap-replace-file-component
213d9a4f
RS
1232 remote-dir (substring name (match-end 1)))))
1233 (ffap-file-exists-string
95a85681 1234 (ffap-replace-file-component remote-dir name))))))
c99310d5
JL
1235 ((and ffap-dired-wildcards
1236 (string-match ffap-dired-wildcards name)
1237 abs
1238 (ffap-file-exists-string (file-name-directory
1239 (directory-file-name name)))
1240 name))
7e1626fb
EZ
1241 ;; Try all parent directories by deleting the trailing directory
1242 ;; name until existing directory is found or name stops changing
1243 ((let ((dir name))
1244 (while (and dir
1245 (not (ffap-file-exists-string dir))
1246 (not (equal dir (setq dir (file-name-directory
1247 (directory-file-name dir)))))))
1248 (ffap-file-exists-string dir)))
213d9a4f 1249 )
3c2c6be2 1250 (set-match-data data))))
213d9a4f 1251\f
0948761d 1252;;; Prompting (`ffap-read-file-or-url'):
213d9a4f 1253;;
87e2d039
RS
1254;; We want to complete filenames as in read-file-name, but also url's
1255;; which read-file-name-internal would truncate at the "//" string.
1256;; The solution here is to replace read-file-name-internal with
1257;; `ffap-read-file-or-url-internal', which checks the minibuffer
1258;; contents before attempting to complete filenames.
213d9a4f
RS
1259
1260(defun ffap-read-file-or-url (prompt guess)
87e2d039 1261 "Read file or url from minibuffer, with PROMPT and initial GUESS."
213d9a4f 1262 (or guess (setq guess default-directory))
87e2d039 1263 (let (dir)
213d9a4f
RS
1264 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
1265 ;; or "w3/" or "../el/ffap.el" or "../../../"
87e2d039 1266 (or (ffap-url-p guess)
213d9a4f
RS
1267 (progn
1268 (or (ffap-file-remote-p guess)
3788c735
KH
1269 (setq guess
1270 (abbreviate-file-name (expand-file-name guess))
1271 ))
213d9a4f 1272 (setq dir (file-name-directory guess))))
07556e35 1273 (let ((minibuffer-completing-file-name t)
d8df1280 1274 (completion-ignore-case read-file-name-completion-ignore-case)
ea27e496
SM
1275 (fnh-elem (cons ffap-url-regexp 'url-file-handler)))
1276 ;; Explain to `rfn-eshadow' that we can use URLs here.
1277 (push fnh-elem file-name-handler-alist)
1278 (unwind-protect
1279 (setq guess
984ddcbc
SM
1280 (let ((default-directory (if dir (expand-file-name dir)
1281 default-directory)))
1282 (completing-read
1283 prompt
1284 'ffap-read-file-or-url-internal
1285 nil
1286 nil
1287 (if dir (cons guess (length dir)) guess)
1288 (list 'file-name-history)
1289 (and buffer-file-name
1290 (abbreviate-file-name buffer-file-name)))))
ea27e496
SM
1291 ;; Remove the special handler manually. We used to just let-bind
1292 ;; file-name-handler-alist to preserve its value, but that caused
1293 ;; other modifications to be lost (e.g. when Tramp gets loaded
1294 ;; during the completing-read call).
1295 (setq file-name-handler-alist (delq fnh-elem file-name-handler-alist))))
87e2d039
RS
1296 ;; Do file substitution like (interactive "F"), suggested by MCOOK.
1297 (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
1298 ;; Should not do it on url's, where $ is a common (VMS?) character.
1299 ;; Note: upcoming url.el package ought to handle this automatically.
1300 guess))
213d9a4f 1301
984ddcbc 1302(defun ffap-read-url-internal (string pred action)
87e2d039
RS
1303 "Complete url's from history, treating given string as valid."
1304 (let ((hist (ffap-soft-value "url-global-history-hash-table")))
213d9a4f
RS
1305 (cond
1306 ((not action)
984ddcbc 1307 (or (try-completion string hist pred) string))
213d9a4f 1308 ((eq action t)
984ddcbc 1309 (or (all-completions string hist pred) (list string)))
87e2d039
RS
1310 ;; action == lambda, documented where? Tests whether string is a
1311 ;; valid "match". Let us always say yes.
1312 (t t))))
213d9a4f 1313
984ddcbc
SM
1314(defun ffap-read-file-or-url-internal (string pred action)
1315 (unless string ;Why would this ever happen?
d4021fd9 1316 (setq string default-directory))
213d9a4f 1317 (if (ffap-url-p string)
984ddcbc
SM
1318 (ffap-read-url-internal string pred action)
1319 (read-file-name-internal string pred action)))
213d9a4f 1320
87e2d039
RS
1321;; The rest of this page is just to work with package complete.el.
1322;; This code assumes that you load ffap.el after complete.el.
1323;;
1324;; We must inform complete about whether our completion function
8daa9f3d 1325;; will do filename style completion.
87e2d039
RS
1326
1327(defun ffap-complete-as-file-p nil
1328 ;; Will `minibuffer-completion-table' complete the minibuffer
1329 ;; contents as a filename? Assumes the minibuffer is current.
1330 ;; Note: t and non-nil mean somewhat different reasons.
1331 (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
1332 (not (ffap-url-p (buffer-string))) ; t
9925c419 1333 (and minibuffer-completing-file-name '(t)))) ;list
87e2d039 1334
213d9a4f
RS
1335(and
1336 (featurep 'complete)
87e2d039
RS
1337 (if (boundp 'PC-completion-as-file-name-predicate)
1338 ;; modern version of complete.el, just set the variable:
8daa9f3d 1339 (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)))
213d9a4f
RS
1340
1341\f
0948761d 1342;;; Highlighting (`ffap-highlight'):
213d9a4f
RS
1343;;
1344;; Based on overlay highlighting in Emacs 19.28 isearch.el.
1345
33514810 1346(defvar ffap-highlight t
213d9a4f
RS
1347 "If non-nil, ffap highlights the current buffer substring.")
1348
dfe72966
JL
1349(defface ffap
1350 '((t :inherit highlight))
1351 "Face used to highlight the current buffer substring."
1352 :group 'ffap
1353 :version "22.1")
1354
0948761d
KH
1355(defvar ffap-highlight-overlay nil
1356 "Overlay used by `ffap-highlight'.")
213d9a4f
RS
1357
1358(defun ffap-highlight (&optional remove)
87e2d039
RS
1359 "If `ffap-highlight' is set, highlight the guess in this buffer.
1360That is, the last buffer substring found by `ffap-string-at-point'.
213d9a4f 1361Optional argument REMOVE means to remove any such highlighting.
87e2d039 1362Uses the face `ffap' if it is defined, or else `highlight'."
213d9a4f 1363 (cond
0948761d
KH
1364 (remove
1365 (and ffap-highlight-overlay
3788c735
KH
1366 (delete-overlay ffap-highlight-overlay))
1367 )
213d9a4f 1368 ((not ffap-highlight) nil)
87e2d039 1369 (ffap-highlight-overlay
3788c735
KH
1370 (move-overlay
1371 ffap-highlight-overlay
1372 (car ffap-string-at-point-region)
1373 (nth 1 ffap-string-at-point-region)
1374 (current-buffer)))
213d9a4f 1375 (t
0948761d 1376 (setq ffap-highlight-overlay
3788c735 1377 (apply 'make-overlay ffap-string-at-point-region))
dfe72966 1378 (overlay-put ffap-highlight-overlay 'face 'ffap))))
87e2d039 1379
213d9a4f 1380\f
3788c735 1381;;; Main Entrance (`find-file-at-point' == `ffap'):
213d9a4f
RS
1382
1383(defun ffap-guesser nil
0948761d 1384 "Return file or URL or nil, guessed from text around point."
213d9a4f
RS
1385 (or (and ffap-url-regexp
1386 (ffap-fixup-url (or (ffap-url-at-point)
1387 (ffap-gopher-at-point))))
1388 (ffap-file-at-point) ; may yield url!
1389 (ffap-fixup-machine (ffap-machine-at-point))))
1390
1391(defun ffap-prompter (&optional guess)
1392 ;; Does guess and prompt step for find-file-at-point.
87e2d039 1393 ;; Extra complication for the temporary highlighting.
213d9a4f 1394 (unwind-protect
3788c735
KH
1395 ;; This catch will let ffap-alist entries do their own prompting
1396 ;; and then maybe skip over this prompt (ff-paths, for example).
1397 (catch 'ffap-prompter
1398 (ffap-read-file-or-url
1399 (if ffap-url-regexp "Find file or URL: " "Find file: ")
1400 (prog1
1401 (setq guess (or guess (ffap-guesser))) ; using ffap-alist here
1402 (and guess (ffap-highlight))
1403 )))
213d9a4f
RS
1404 (ffap-highlight t)))
1405
1406;;;###autoload
1407(defun find-file-at-point (&optional filename)
0948761d
KH
1408 "Find FILENAME, guessing a default from text around point.
1409If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
1410With a prefix, this command behaves exactly like `ffap-file-finder'.
213d9a4f 1411If `ffap-require-prefix' is set, the prefix meaning is reversed.
0948761d 1412See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
57eb2e24 1413and the functions `ffap-file-at-point' and `ffap-url-at-point'."
213d9a4f
RS
1414 (interactive)
1415 (if (and (interactive-p)
1416 (if ffap-require-prefix (not current-prefix-arg)
1417 current-prefix-arg))
1418 ;; Do exactly the ffap-file-finder command, even the prompting:
87e2d039
RS
1419 (let (current-prefix-arg) ; we already interpreted it
1420 (call-interactively ffap-file-finder))
213d9a4f
RS
1421 (or filename (setq filename (ffap-prompter)))
1422 (cond
1423 ((ffap-url-p filename)
87e2d039
RS
1424 (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC
1425 (funcall ffap-url-fetcher filename)))
5b523a77
JL
1426 ((and ffap-pass-wildcards-to-dired
1427 ffap-dired-wildcards
1428 (string-match ffap-dired-wildcards filename))
1429 (funcall ffap-directory-finder filename))
87e2d039 1430 ((and ffap-dired-wildcards
c99310d5
JL
1431 (string-match ffap-dired-wildcards filename)
1432 find-file-wildcards
1433 ;; Check if it's find-file that supports wildcards arg
1434 (memq ffap-file-finder '(find-file find-alternate-file)))
1435 (funcall ffap-file-finder (expand-file-name filename) t))
213d9a4f
RS
1436 ((or (not ffap-newfile-prompt)
1437 (file-exists-p filename)
1438 (y-or-n-p "File does not exist, create buffer? "))
1439 (funcall ffap-file-finder
1440 ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
1441 (expand-file-name filename)))
1442 ;; User does not want to find a non-existent file:
1443 ((signal 'file-error (list "Opening file buffer"
1444 "no such file or directory"
1445 filename))))))
1446
0948761d 1447;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
22ac7ca0
MR
1448;;;###autoload
1449(defalias 'ffap 'find-file-at-point)
1450
213d9a4f 1451\f
0948761d 1452;;; Menu support (`ffap-menu'):
213d9a4f
RS
1453
1454(defvar ffap-menu-regexp nil
87e2d039 1455 "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
213d9a4f 1456Make this more restrictive for faster menu building.
0948761d 1457For example, try \":/\" for URL (and some ftp) references.")
213d9a4f
RS
1458
1459(defvar ffap-menu-alist nil
87e2d039 1460 "Buffer local cache of menu presented by `ffap-menu'.")
213d9a4f
RS
1461(make-variable-buffer-local 'ffap-menu-alist)
1462
87e2d039 1463(defvar ffap-menu-text-plist
3788c735 1464 (cond
33514810
EZ
1465 ((display-mouse-p) '(face bold mouse-face highlight)) ; keymap <mousy-map>
1466 (t nil))
87e2d039
RS
1467 "Text properties applied to strings found by `ffap-menu-rescan'.
1468These properties may be used to fontify the menu references.")
1469
213d9a4f
RS
1470;;;###autoload
1471(defun ffap-menu (&optional rescan)
87e2d039
RS
1472 "Put up a menu of files and urls mentioned in this buffer.
1473Then set mark, jump to choice, and try to fetch it. The menu is
1474cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
1475The optional RESCAN argument \(a prefix, interactively\) forces
1476a rebuild. Searches with `ffap-menu-regexp'."
213d9a4f
RS
1477 (interactive "P")
1478 ;; (require 'imenu) -- no longer used, but roughly emulated
1479 (if (or (not ffap-menu-alist) rescan
1480 ;; or if the first entry is wrong:
1481 (and ffap-menu-alist
1482 (let ((first (car ffap-menu-alist)))
1483 (save-excursion
1484 (goto-char (cdr first))
1485 (not (equal (car first) (ffap-guesser)))))))
1486 (ffap-menu-rescan))
1487 ;; Tail recursive:
1488 (ffap-menu-ask
1489 (if ffap-url-regexp "Find file or URL" "Find file")
1490 (cons (cons "*Rescan Buffer*" -1) ffap-menu-alist)
1491 'ffap-menu-cont))
1492
1493(defun ffap-menu-cont (choice) ; continuation of ffap-menu
1494 (if (< (cdr choice) 0)
1495 (ffap-menu t) ; *Rescan*
1496 (push-mark)
1497 (goto-char (cdr choice))
1498 ;; Momentary highlight:
1499 (unwind-protect
1500 (progn
1501 (and ffap-highlight (ffap-guesser) (ffap-highlight))
1502 (sit-for 0) ; display
1503 (find-file-at-point (car choice)))
1504 (ffap-highlight t))))
1505
1506(defun ffap-menu-ask (title alist cont)
1507 "Prompt from a menu of choices, and then apply some action.
0948761d 1508Arguments are TITLE, ALIST, and CONT \(a continuation function\).
213d9a4f
RS
1509This uses either a menu or the minibuffer depending on invocation.
1510The TITLE string is used as either the prompt or menu title.
ee79ced8 1511Each ALIST entry looks like (STRING . DATA) and defines one choice.
0948761d
KH
1512Function CONT is applied to the entry chosen by the user."
1513 ;; Note: this function is used with a different continuation
1514 ;; by the ffap-url add-on package.
1515 ;; Could try rewriting to use easymenu.el or lmenu.el.
1516 (let (choice)
1517 (cond
1518 ;; Emacs mouse:
1519 ((and (fboundp 'x-popup-menu) (ffap-mouse-event))
1520 (setq choice
1521 (x-popup-menu
1522 t
1523 (list "" (cons title
984ddcbc 1524 (mapcar (lambda (i) (cons (car i) i))
0948761d
KH
1525 alist))))))
1526 ;; minibuffer with completion buffer:
1527 (t
1528 (let ((minibuffer-setup-hook 'minibuffer-completion-help))
1529 ;; Bug: prompting may assume unique strings, no "".
1530 (setq choice
1531 (completing-read
1532 (format "%s (default %s): " title (car (car alist)))
1533 alist nil t
1534 ;; (cons (car (car alist)) 0)
1535 nil)))
1536 (sit-for 0) ; redraw original screen
1537 ;; Convert string to its entry, or else the default:
984ddcbc 1538 (setq choice (or (assoc choice alist) (car alist)))))
0948761d
KH
1539 (if choice
1540 (funcall cont choice)
1541 (message "No choice made!") ; possible with menus
1542 nil)))
213d9a4f
RS
1543
1544(defun ffap-menu-rescan nil
87e2d039
RS
1545 "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
1546Applies `ffap-menu-text-plist' text properties at all matches."
213d9a4f
RS
1547 (interactive)
1548 (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
0948761d
KH
1549 (range (- (point-max) (point-min)))
1550 (mod (buffer-modified-p)) ; was buffer modified?
e27de09e
EZ
1551 ;; inhibit-read-only works on read-only text properties
1552 ;; as well as read-only buffers.
1553 (inhibit-read-only t) ; to set text-properties
0948761d 1554 item
87e2d039
RS
1555 ;; Avoid repeated searches of the *mode-alist:
1556 (major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
1557 major-mode
0948761d 1558 'file)))
213d9a4f 1559 (setq ffap-menu-alist nil)
0948761d
KH
1560 (unwind-protect
1561 (save-excursion
1562 (goto-char (point-min))
1563 (while (setq item (ffap-next-guess))
1564 (setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist))
1565 (add-text-properties (car ffap-string-at-point-region) (point)
1566 ffap-menu-text-plist)
1567 (message "Scanning...%2d%% <%s>"
1568 (/ (* 100 (- (point) (point-min))) range) item)))
984ddcbc 1569 (or mod (restore-buffer-modified-p nil))))
213d9a4f
RS
1570 (message "Scanning...done")
1571 ;; Remove duplicates.
1572 (setq ffap-menu-alist ; sort by item
1573 (sort ffap-menu-alist
1574 (function
1575 (lambda (a b) (string-lessp (car a) (car b))))))
0948761d 1576 (let ((ptr ffap-menu-alist)) ; remove duplicates
213d9a4f
RS
1577 (while (cdr ptr)
1578 (if (equal (car (car ptr)) (car (car (cdr ptr))))
1579 (setcdr ptr (cdr (cdr ptr)))
1580 (setq ptr (cdr ptr)))))
1581 (setq ffap-menu-alist ; sort by position
1582 (sort ffap-menu-alist
1583 (function
1584 (lambda (a b) (< (cdr a) (cdr b)))))))
1585
1586\f
0948761d 1587;;; Mouse Support (`ffap-at-mouse'):
213d9a4f 1588;;
87e2d039 1589;; See the suggested binding in ffap-bindings (near eof).
213d9a4f 1590
0948761d
KH
1591(defvar ffap-at-mouse-fallback nil ; ffap-menu? too time-consuming
1592 "Command invoked by `ffap-at-mouse' if nothing found at click, or nil.
1593Ignored when `ffap-at-mouse' is called programmatically.")
213d9a4f
RS
1594(put 'ffap-at-mouse-fallback 'risky-local-variable t)
1595
0948761d 1596;;;###autoload
213d9a4f 1597(defun ffap-at-mouse (e)
0948761d 1598 "Find file or url guessed from text around mouse click.
3788c735
KH
1599Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
1600Return value:
1601 * if a guess string is found, return it (after finding it)
1602 * if the fallback is called, return whatever it returns
1603 * otherwise, nil"
213d9a4f
RS
1604 (interactive "e")
1605 (let ((guess
1606 ;; Maybe less surprising without the save-excursion?
1607 (save-excursion
1608 (mouse-set-point e)
0948761d
KH
1609 ;; Would prefer to do nothing unless click was *on* text. How
1610 ;; to tell that the click was beyond the end of current line?
213d9a4f
RS
1611 (ffap-guesser))))
1612 (cond
1613 (guess
0948761d 1614 (set-buffer (ffap-event-buffer e))
213d9a4f
RS
1615 (ffap-highlight)
1616 (unwind-protect
1617 (progn
1618 (sit-for 0) ; display
0948761d
KH
1619 (message "Finding `%s'" guess)
1620 (find-file-at-point guess)
3788c735 1621 guess) ; success: return non-nil
213d9a4f 1622 (ffap-highlight t)))
0948761d
KH
1623 ((interactive-p)
1624 (if ffap-at-mouse-fallback
1625 (call-interactively ffap-at-mouse-fallback)
3788c735
KH
1626 (message "No file or url found at mouse click.")
1627 nil)) ; no fallback, return nil
0948761d
KH
1628 ;; failure: return nil
1629 )))
213d9a4f
RS
1630
1631\f
c99310d5 1632;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands:
0948761d
KH
1633
1634;; There could be a real `ffap-noselect' function, but we would need
1635;; at least two new user variables, and there is no w3-fetch-noselect.
1636;; So instead, we just fake it with a slow save-window-excursion.
213d9a4f
RS
1637
1638(defun ffap-other-window nil
0948761d
KH
1639 "Like `ffap', but put buffer in another window.
1640Only intended for interactive use."
213d9a4f 1641 (interactive)
c99310d5
JL
1642 (let (value)
1643 (switch-to-buffer-other-window
1644 (save-window-excursion
1645 (setq value (call-interactively 'ffap))
1646 (unless (or (bufferp value) (bufferp (car-safe value)))
1647 (setq value (current-buffer)))
1648 (current-buffer)))
1649 value))
213d9a4f
RS
1650
1651(defun ffap-other-frame nil
0948761d
KH
1652 "Like `ffap', but put buffer in another frame.
1653Only intended for interactive use."
213d9a4f 1654 (interactive)
0948761d 1655 ;; Extra code works around dedicated windows (noted by JENS, 7/96):
c99310d5
JL
1656 (let* ((win (selected-window))
1657 (wdp (window-dedicated-p win))
1658 value)
0948761d
KH
1659 (unwind-protect
1660 (progn
1661 (set-window-dedicated-p win nil)
1662 (switch-to-buffer-other-frame
1663 (save-window-excursion
c99310d5
JL
1664 (setq value (call-interactively 'ffap))
1665 (unless (or (bufferp value) (bufferp (car-safe value)))
1666 (setq value (current-buffer)))
0948761d 1667 (current-buffer))))
c99310d5
JL
1668 (set-window-dedicated-p win wdp))
1669 value))
1670
1671(defun ffap-read-only ()
1672 "Like `ffap', but mark buffer as read-only.
1673Only intended for interactive use."
1674 (interactive)
1675 (let ((value (call-interactively 'ffap)))
1676 (unless (or (bufferp value) (bufferp (car-safe value)))
1677 (setq value (current-buffer)))
1678 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1679 (if (listp value) value (list value)))
1680 value))
1681
1682(defun ffap-read-only-other-window ()
1683 "Like `ffap', but put buffer in another window and mark as read-only.
1684Only intended for interactive use."
1685 (interactive)
1686 (let ((value (ffap-other-window)))
1687 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1688 (if (listp value) value (list value)))
1689 value))
1690
1691(defun ffap-read-only-other-frame ()
1692 "Like `ffap', but put buffer in another frame and mark as read-only.
1693Only intended for interactive use."
1694 (interactive)
1695 (let ((value (ffap-other-frame)))
1696 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
1697 (if (listp value) value (list value)))
1698 value))
1699
1700(defun ffap-alternate-file ()
1701 "Like `ffap' and `find-alternate-file'.
1702Only intended for interactive use."
1703 (interactive)
1704 (let ((ffap-file-finder 'find-alternate-file))
1705 (call-interactively 'ffap)))
213d9a4f
RS
1706
1707\f
87e2d039
RS
1708;;; Bug Reporter:
1709
36b5be6b
GM
1710(define-obsolete-function-alias 'ffap-bug 'report-emacs-bug "23.1")
1711(define-obsolete-function-alias 'ffap-submit-bug 'report-emacs-bug "23.1")
213d9a4f
RS
1712
1713\f
87e2d039 1714;;; Hooks for Gnus, VM, Rmail:
213d9a4f 1715;;
87e2d039
RS
1716;; If you do not like these bindings, write versions with whatever
1717;; bindings you would prefer.
213d9a4f 1718
87e2d039
RS
1719(defun ffap-ro-mode-hook nil
1720 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
1721 (local-set-key "\M-l" 'ffap-next)
1722 (local-set-key "\M-m" 'ffap-menu)
1723 )
213d9a4f 1724
87e2d039
RS
1725(defun ffap-gnus-hook nil
1726 "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
1727 (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
1728 ;; Note "l", "L", "m", "M" are taken:
1729 (local-set-key "\M-l" 'ffap-gnus-next)
1730 (local-set-key "\M-m" 'ffap-gnus-menu))
213d9a4f 1731
9890a229
RS
1732(defvar gnus-summary-buffer)
1733(defvar gnus-article-buffer)
1734
36b5be6b
GM
1735;; This code is called from gnus.
1736(declare-function gnus-summary-select-article "gnus-sum"
1737 (&optional all-headers force pseudo article))
1738
1739(declare-function gnus-configure-windows "gnus-win"
1740 (setting &optional force))
1741
87e2d039
RS
1742(defun ffap-gnus-wrapper (form) ; used by both commands below
1743 (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
1744 (gnus-summary-select-article)) ; get article of current line
1745 ;; Preserve selected buffer, but do not do save-window-excursion,
1746 ;; since we want to see any window created by the form. Temporarily
1747 ;; select the article buffer, so we can see any point movement.
1748 (let ((sb (window-buffer (selected-window))))
1749 (gnus-configure-windows 'article)
1750 (pop-to-buffer gnus-article-buffer)
1751 (widen)
1752 ;; Skip headers for ffap-gnus-next (which will wrap around)
1753 (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
1754 (unwind-protect
1755 (eval form)
1756 (pop-to-buffer sb))))
1757
1758(defun ffap-gnus-next nil
1759 "Run `ffap-next' in the gnus article buffer."
1760 (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
1761
1762(defun ffap-gnus-menu nil
1763 "Run `ffap-menu' in the gnus article buffer."
1764 (interactive) (ffap-gnus-wrapper '(ffap-menu)))
1765
1766\f
61154252
RS
1767(defcustom dired-at-point-require-prefix nil
1768 "*If set, reverses the prefix argument to `dired-at-point'.
1769This is nil so neophytes notice ffap. Experts may prefer to disable
1770ffap most of the time."
1771 :type 'boolean
1772 :group 'ffap
1773 :version "20.3")
1774
1775;;;###autoload
1776(defun dired-at-point (&optional filename)
1777 "Start Dired, defaulting to file at point. See `ffap'."
1778 (interactive)
1779 (if (and (interactive-p)
1780 (if dired-at-point-require-prefix
1781 (not current-prefix-arg)
1782 current-prefix-arg))
1783 (let (current-prefix-arg) ; already interpreted
c99310d5 1784 (call-interactively ffap-directory-finder))
61154252
RS
1785 (or filename (setq filename (dired-at-point-prompter)))
1786 (cond
1787 ((ffap-url-p filename)
1788 (funcall ffap-url-fetcher filename))
1789 ((and ffap-dired-wildcards
1790 (string-match ffap-dired-wildcards filename))
c99310d5 1791 (funcall ffap-directory-finder filename))
61154252
RS
1792 ((file-exists-p filename)
1793 (if (file-directory-p filename)
c99310d5
JL
1794 (funcall ffap-directory-finder
1795 (expand-file-name filename))
1796 (funcall ffap-directory-finder
1797 (concat (expand-file-name filename) "*"))))
0f76d837
JL
1798 ((and (file-writable-p
1799 (or (file-name-directory (directory-file-name filename))
1800 filename))
3fa86f26 1801 (y-or-n-p "Directory does not exist, create it? "))
61154252 1802 (make-directory filename)
c99310d5 1803 (funcall ffap-directory-finder filename))
61154252
RS
1804 ((error "No such file or directory `%s'" filename)))))
1805
1806(defun dired-at-point-prompter (&optional guess)
1807 ;; Does guess and prompt step for find-file-at-point.
1808 ;; Extra complication for the temporary highlighting.
1809 (unwind-protect
1810 (ffap-read-file-or-url
0fdc185e
MR
1811 (cond
1812 ((eq ffap-directory-finder 'list-directory)
1813 "List directory (brief): ")
1814 (ffap-url-regexp "Dired file or URL: ")
1815 (t "Dired file: "))
61154252 1816 (prog1
0f76d837
JL
1817 (setq guess (or guess
1818 (let ((guess (ffap-guesser)))
1819 (if (or (not guess)
1820 (ffap-url-p guess)
1821 (ffap-file-remote-p guess))
1822 guess
1823 (setq guess (abbreviate-file-name
1824 (expand-file-name guess)))
1825 (cond
1826 ;; Interpret local directory as a directory.
1827 ((file-directory-p guess)
1828 (file-name-as-directory guess))
1829 ;; Get directory component from local files.
1830 ((file-regular-p guess)
1831 (file-name-directory guess))
1832 (guess))))
1833 ))
1834 (and guess (ffap-highlight))))
61154252
RS
1835 (ffap-highlight t)))
1836\f
c99310d5
JL
1837;;; ffap-dired-other-*, ffap-list-directory commands:
1838
1839(defun ffap-dired-other-window ()
1840 "Like `dired-at-point', but put buffer in another window.
1841Only intended for interactive use."
1842 (interactive)
1843 (let (value)
1844 (switch-to-buffer-other-window
1845 (save-window-excursion
1846 (setq value (call-interactively 'dired-at-point))
1847 (current-buffer)))
1848 value))
1849
1850(defun ffap-dired-other-frame ()
1851 "Like `dired-at-point', but put buffer in another frame.
1852Only intended for interactive use."
1853 (interactive)
1854 ;; Extra code works around dedicated windows (noted by JENS, 7/96):
1855 (let* ((win (selected-window))
1856 (wdp (window-dedicated-p win))
1857 value)
1858 (unwind-protect
1859 (progn
1860 (set-window-dedicated-p win nil)
1861 (switch-to-buffer-other-frame
1862 (save-window-excursion
1863 (setq value (call-interactively 'dired-at-point))
1864 (current-buffer))))
1865 (set-window-dedicated-p win wdp))
1866 value))
1867
1868(defun ffap-list-directory ()
1869 "Like `dired-at-point' and `list-directory'.
1870Only intended for interactive use."
1871 (interactive)
1872 (let ((ffap-directory-finder 'list-directory))
1873 (call-interactively 'dired-at-point)))
1874
1875\f
0948761d 1876;;; Offer default global bindings (`ffap-bindings'):
87e2d039
RS
1877
1878(defvar ffap-bindings
3788c735
KH
1879 '(
1880 (global-set-key [S-mouse-3] 'ffap-at-mouse)
1881 (global-set-key [C-S-mouse-3] 'ffap-menu)
c99310d5 1882
3788c735 1883 (global-set-key "\C-x\C-f" 'find-file-at-point)
c99310d5
JL
1884 (global-set-key "\C-x\C-r" 'ffap-read-only)
1885 (global-set-key "\C-x\C-v" 'ffap-alternate-file)
1886
3788c735
KH
1887 (global-set-key "\C-x4f" 'ffap-other-window)
1888 (global-set-key "\C-x5f" 'ffap-other-frame)
c99310d5
JL
1889 (global-set-key "\C-x4r" 'ffap-read-only-other-window)
1890 (global-set-key "\C-x5r" 'ffap-read-only-other-frame)
1891
3d729a9a 1892 (global-set-key "\C-xd" 'dired-at-point)
c99310d5
JL
1893 (global-set-key "\C-x4d" 'ffap-dired-other-window)
1894 (global-set-key "\C-x5d" 'ffap-dired-other-frame)
1895 (global-set-key "\C-x\C-d" 'ffap-list-directory)
1896
3788c735
KH
1897 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
1898 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
1899 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
1900 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
1901 ;; (setq dired-x-hands-off-my-keys t) ; the default
1902 )
1903 "List of binding forms evaluated by function `ffap-bindings'.
148b5960 1904A reasonable ffap installation needs just this one line:
87e2d039 1905 (ffap-bindings)
0948761d 1906Of course if you do not like these bindings, just roll your own!")
87e2d039 1907
25050dab 1908;;;###autoload
87e2d039
RS
1909(defun ffap-bindings nil
1910 "Evaluate the forms in variable `ffap-bindings'."
25050dab 1911 (interactive)
87e2d039
RS
1912 (eval (cons 'progn ffap-bindings)))
1913
87e2d039 1914\f
ab5796a9 1915
cbee283d 1916;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc
213d9a4f 1917;;; ffap.el ends here