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