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