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