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