ffap.el 68.6 KB
Newer Older
1 2
;;; ffap.el --- find file (or url) at point

3
;; Copyright (C) 1995, 1996, 1997, 2000, 2002, 2003, 2004,
4
;;   2005, 2006 Free Software Foundation, Inc.
5

Erik Naggum's avatar
Erik Naggum committed
6
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
Richard M. Stallman's avatar
Richard M. Stallman committed
7
;; Maintainer: Rajesh Vaidheeswarran  <rv@gnu.org>
8
;; Created: 29 Mar 1993
Dan Nicolaescu's avatar
Dan Nicolaescu committed
9
;; Keywords: files, hypermedia, matching, mouse, convenience
10
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
Richard M. Stallman's avatar
Richard M. Stallman committed
11 12 13 14 15 16 17 18 19 20 21 22 23 24

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
26 27
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
28 29


30
;;; Commentary:
Richard M. Stallman's avatar
Richard M. Stallman committed
31
;;
32 33
;; Command find-file-at-point replaces find-file.  With a prefix, it
;; behaves exactly like find-file.  Without a prefix, it first tries
34
;; to guess a default file or URL from the text around the point
35 36 37 38
;; (`ffap-require-prefix' swaps these behaviors).  This is useful for
;; following references in situations such as mail or news buffers,
;; README's, MANIFEST's, and so on.  Submit bugs or suggestions with
;; M-x ffap-bug.
Richard M. Stallman's avatar
Richard M. Stallman committed
39
;;
40
;; For the default installation, add this line to your .emacs file:
Richard M. Stallman's avatar
Richard M. Stallman committed
41
;;
42
;; (ffap-bindings)                      ; do default key bindings
Richard M. Stallman's avatar
Richard M. Stallman committed
43
;;
44
;; ffap-bindings makes the following global key bindings:
Richard M. Stallman's avatar
Richard M. Stallman committed
45
;;
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
;; C-x C-f		find-file-at-point (abbreviated as ffap)
;; C-x C-r		ffap-read-only
;; C-x C-v		ffap-alternate-file
;;
;; C-x d		dired-at-point
;; C-x C-d		ffap-list-directory
;;
;; C-x 4 f		ffap-other-window
;; C-x 4 r		ffap-read-only-other-window
;; C-x 4 d		ffap-dired-other-window
;;
;; C-x 5 f		ffap-other-frame
;; C-x 5 r		ffap-read-only-other-frame
;; C-x 5 d		ffap-dired-other-frame
;;
61
;; S-mouse-3     ffap-at-mouse
62
;; C-S-mouse-3   ffap-menu
Richard M. Stallman's avatar
Richard M. Stallman committed
63
;;
64 65
;; ffap-bindings also adds hooks to make the following local bindings
;; in vm, gnus, and rmail:
Richard M. Stallman's avatar
Richard M. Stallman committed
66
;;
67 68
;; M-l         ffap-next, or ffap-gnus-next in gnus (l == "link")
;; M-m         ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
Richard M. Stallman's avatar
Richard M. Stallman committed
69
;;
70 71
;; If you do not like these bindings, modify the variable
;; `ffap-bindings', or write your own.
Richard M. Stallman's avatar
Richard M. Stallman committed
72
;;
73 74 75 76
;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
;; to load or autoload them before ffap.  If you use ff-paths, load it
;; afterwards.  Try apropos {C-h a ffap RET} to get a list of the many
;; option variables.  In particular, if ffap is slow, try these:
Richard M. Stallman's avatar
Richard M. Stallman committed
77
;;
78 79
;; (setq ffap-alist nil)                ; faster, dumber prompting
;; (setq ffap-machine-p-known 'accept)  ; no pinging
80
;; (setq ffap-url-regexp nil)           ; disable URL features in ffap
81
;; (setq ffap-shell-prompt-regexp nil)  ; disable shell prompt stripping
Richard M. Stallman's avatar
Richard M. Stallman committed
82
;;
83 84
;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
85
;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
86
;; the file and URL references within a buffer.
87

88 89 90 91 92 93 94

;;; Change Log:
;;
;; The History and Contributors moved to ffap.LOG (same ftp site),
;; which also has some old examples and commentary from ffap 1.5.


95
;;; Todo list:
96
;; * use kpsewhich
Richard M. Stallman's avatar
Richard M. Stallman committed
97
;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file
98
;; * find file of symbol if TAGS is loaded (like above)
99 100
;; * break long menus into multiple panes (like imenu?)
;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
Richard M. Stallman's avatar
Richard M. Stallman committed
101
;; * notice "machine.dom blah blah blah dir/file" (how?)
102
;; * as w3 becomes standard, rewrite to rely more on its functions
103 104
;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
105 106
;; * handle "$(VAR)" in Makefiles
;; * use the font-lock machinery
Richard M. Stallman's avatar
Richard M. Stallman committed
107 108 109 110 111 112


;;; Code:

(provide 'ffap)

113 114 115
;; Please do not delete this variable, it is checked in bug reports.
(defconst ffap-version "1.9-fsf <97/06/25 13:21:41 mic>"
  "The version of ffap: \"Major.Minor-Build <Timestamp>\"")
116

Richard M. Stallman's avatar
Richard M. Stallman committed
117

118 119
(defgroup ffap nil
  "Find file or URL at point."
120
  :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/")
Dan Nicolaescu's avatar
Dan Nicolaescu committed
121 122
  :group 'matching
  :group 'convenience)
123

124 125 126 127 128
;; The code is organized in pages, separated by formfeed characters.
;; See the next two pages for standard customization ideas.


;;; User Variables:
129

130
(defun ffap-soft-value (name &optional default)
131 132 133
  "Return value of symbol with NAME, if it is interned.
Otherwise return nil (or the optional DEFAULT value)."
  ;; Bug: (ffap-soft-value "nil" 5) --> 5
Richard M. Stallman's avatar
Richard M. Stallman committed
134
  (let ((sym (intern-soft name)))
135
    (if (and sym (boundp sym)) (symbol-value sym) default)))
Richard M. Stallman's avatar
Richard M. Stallman committed
136

137 138 139 140 141 142 143 144 145 146 147 148
(defcustom ffap-shell-prompt-regexp
  ;; This used to test for some shell prompts that don't have a space
  ;; after them. The common root shell prompt (#) is not listed since it
  ;; also doubles up as a valid URL character.
  "[$%><]*"
  "Paths matching this regexp are stripped off the shell prompt
If nil, ffap doesn't do shell prompt stripping."
  :type '(choice (const :tag "Disable" nil)
		  (const :tag "Standard" "[$%><]*")
		   regexp)
  :group 'ffap)

149
(defcustom ffap-ftp-regexp
150 151 152
  ;; This used to test for ange-ftp or efs being present, but it should be
  ;; harmless (and simpler) to give it this value unconditionally.
  "\\`/[^/:]+:"
Richard M. Stallman's avatar
Richard M. Stallman committed
153 154
  "*File names matching this regexp are treated as remote ffap.
If nil, ffap neither recognizes nor generates such names."
155
  :type '(choice (const :tag "Disable" nil)
156
		 (const :tag "Standard" "\\`/[^/:]+:")
157 158 159 160
		 regexp)
  :group 'ffap)

(defcustom ffap-url-unwrap-local t
Richard M. Stallman's avatar
Richard M. Stallman committed
161
  "*If non-nil, convert `file:' URL to local file name before prompting."
162 163 164 165
  :type 'boolean
  :group 'ffap)

(defcustom ffap-url-unwrap-remote t
Richard M. Stallman's avatar
Richard M. Stallman committed
166
  "*If non-nil, convert `ftp:' URL to remote file name before prompting.
167 168 169 170
This is ignored if `ffap-ftp-regexp' is nil."
  :type 'boolean
  :group 'ffap)

171
(defcustom ffap-ftp-default-user "anonymous"
Richard M. Stallman's avatar
Richard M. Stallman committed
172
  "*User name in ftp file names generated by `ffap-host-to-path'.
173 174 175
Note this name may be omitted if it equals the default
\(either `efs-default-user' or `ange-ftp-default-user'\)."
  :type 'string
176
  :group 'ffap)
Richard M. Stallman's avatar
Richard M. Stallman committed
177

178
(defcustom ffap-rfs-regexp
Richard M. Stallman's avatar
Richard M. Stallman committed
179 180 181
  ;; Remote file access built into file system?  HP rfa or Andrew afs:
  "\\`/\\(afs\\|net\\)/."
  ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
Richard M. Stallman's avatar
Richard M. Stallman committed
182
  "*Matching file names are treated as remote.  Use nil to disable."
183 184
  :type 'regexp
  :group 'ffap)
Richard M. Stallman's avatar
Richard M. Stallman committed
185 186 187 188 189 190 191 192

(defvar ffap-url-regexp
  ;; Could just use `url-nonrelative-link' of w3, if loaded.
  ;; This regexp is not exhaustive, it just matches common cases.
  (concat
   "\\`\\("
   "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
   "\\|"
193
   "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
Richard M. Stallman's avatar
Richard M. Stallman committed
194 195
   "\\)."				; require one more character
   )
196
   "Regexp matching URL's.  nil to disable URL features in ffap.")
Richard M. Stallman's avatar
Richard M. Stallman committed
197

198 199 200
(defcustom ffap-foo-at-bar-prefix "mailto"
  "*Presumed URL prefix type of strings like \"<foo.9z@bar>\".
Sensible values are nil, \"news\", or \"mailto\"."
201 202 203 204 205
  :type '(choice (const "mailto")
		 (const "news")
		 (const :tag "Disable" nil)
		 ;; string -- possible, but not really useful
		 )
206
  :group 'ffap)
Richard M. Stallman's avatar
Richard M. Stallman committed
207 208


209
;;; Peanut Gallery (More User Variables):
210
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
211 212 213
;; Users of ffap occasionally suggest new features.  If I consider
;; those features interesting but not clear winners (a matter of
;; personal taste) I try to leave options to enable them.  Read
214 215
;; through this section for features that you like, put an appropriate
;; enabler in your .emacs file.
Richard M. Stallman's avatar
Richard M. Stallman committed
216

217
(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
Richard M. Stallman's avatar
Richard M. Stallman committed
218
  "*A regexp matching filename wildcard characters, or nil.
219

220
If `find-file-at-point' gets a filename matching this pattern,
221 222 223 224 225 226 227
and `ffap-pass-wildcards-to-dired' is nil, it passes it on to
`find-file' with non-nil WILDCARDS argument, which expands
wildcards and visits multiple files.  To visit a file whose name
contains wildcard characters you can suppress wildcard expansion
by setting `find-file-wildcards'.  If `find-file-at-point' gets a
filename matching this pattern and `ffap-pass-wildcards-to-dired'
is non-nil, it passes it on to `dired'.
228 229 230

If `dired-at-point' gets a filename matching this pattern,
it passes it on to `dired'."
231 232 233 234
  :type '(choice (const :tag "Disable" nil)
		 (const :tag "Enable" "[*?][^/]*\\'")
		 ;; regexp -- probably not useful
		 )
235
  :group 'ffap)
Richard M. Stallman's avatar
Richard M. Stallman committed
236

237 238 239 240 241
(defcustom ffap-pass-wildcards-to-dired nil
  "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired."
  :type 'boolean
  :group 'ffap)

242
(defcustom ffap-newfile-prompt nil
243 244
  ;; Suggestion from RHOGEE, 11 Jul 1994.  Disabled, I think this is
  ;; better handled by `find-file-not-found-hooks'.
245 246 247
  "*Whether `find-file-at-point' prompts about a nonexistent file."
  :type 'boolean
  :group 'ffap)
Richard M. Stallman's avatar
Richard M. Stallman committed
248

249
(defcustom ffap-require-prefix nil
250 251 252
  ;; Suggestion from RHOGEE, 20 Oct 1994.
  "*If set, reverses the prefix argument to `find-file-at-point'.
This is nil so neophytes notice ffap.  Experts may prefer to disable
253 254 255 256 257 258 259 260
ffap most of the time."
  :type 'boolean
  :group 'ffap)

(defcustom ffap-file-finder 'find-file
  "*The command called by `find-file-at-point' to find a file."
  :type 'function
  :group 'ffap)
261
(put 'ffap-file-finder 'risky-local-variable t)
Richard M. Stallman's avatar
Richard M. Stallman committed
262

263 264 265 266 267 268
(defcustom ffap-directory-finder 'dired
  "*The command called by `dired-at-point' to find a directory."
  :type 'function
  :group 'ffap)
(put 'ffap-directory-finder 'risky-local-variable t)

269
(defcustom ffap-url-fetcher
270 271 272
  (if (fboundp 'browse-url)
      'browse-url			; rely on browse-url-browser-function
    'w3-fetch)
273
  ;; Remote control references:
Richard M. Stallman's avatar
Richard M. Stallman committed
274 275
  ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
  ;; http://home.netscape.com/newsref/std/x-remote.html
276
  "*A function of one argument, called by ffap to fetch an URL.
277
Reasonable choices are `w3-fetch' or a `browse-url-*' function.
Karl Heuer's avatar
Karl Heuer committed
278
For a fancy alternative, get `ffap-url.el'."
279
  :type '(choice (const w3-fetch)
280
		 (const browse-url)	; in recent versions of browse-url
281 282 283
		 (const browse-url-netscape)
		 (const browse-url-mosaic)
		 function)
284
  :group 'ffap)
Richard M. Stallman's avatar
Richard M. Stallman committed
285 286 287
(put 'ffap-url-fetcher 'risky-local-variable t)


288 289
;;; Compatibility:
;;
Richard M. Stallman's avatar
Richard M. Stallman committed
290 291 292
;; This version of ffap supports only the Emacs it is distributed in.
;; See the ftp site for a more general version.  The following
;; functions are necessary "leftovers" from the more general version.
293 294 295 296 297

(defun ffap-mouse-event nil		; current mouse event, or nil
  (and (listp last-nonmenu-event) last-nonmenu-event))
(defun ffap-event-buffer (event)
  (window-buffer (car (event-start event))))
298 299 300


;;; Find Next Thing in buffer (`ffap-next'):
Richard M. Stallman's avatar
Richard M. Stallman committed
301
;;
302 303 304
;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995.  Since
;; then, broke it up into ffap-next-guess (noninteractive) and
;; ffap-next (a command).  It now work on files as well as url's.
Richard M. Stallman's avatar
Richard M. Stallman committed
305

306
(defcustom ffap-next-regexp
Richard M. Stallman's avatar
Richard M. Stallman committed
307 308 309 310 311 312 313
  ;; If you want ffap-next to find URL's only, try this:
  ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
  ;;	  (concat "\\<" (substring ffap-url-regexp 2))))
  ;;
  ;; It pays to put a big fancy regexp here, since ffap-guesser is
  ;; much more time-consuming than regexp searching:
  "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
314 315 316
  "*Regular expression governing movements of `ffap-next'."
  :type 'regexp
  :group 'ffap)
Richard M. Stallman's avatar
Richard M. Stallman committed
317

318 319 320 321 322 323
(defvar ffap-next-guess nil
  "Last value returned by `ffap-next-guess'.")

(defvar ffap-string-at-point-region '(1 1)
  "List (BEG END), last region returned by `ffap-string-at-point'.")

Richard M. Stallman's avatar
Richard M. Stallman committed
324
(defun ffap-next-guess (&optional back lim)
325
  "Move point to next file or URL, and return it as a string.
326
If nothing is found, leave point at limit and return nil.
Richard M. Stallman's avatar
Richard M. Stallman committed
327 328 329 330 331 332 333 334 335 336 337 338 339 340 341
Optional BACK argument makes search backwards.
Optional LIM argument limits the search.
Only considers strings that match `ffap-next-regexp'."
  (or lim (setq lim (if back (point-min) (point-max))))
  (let (guess)
    (while (not (or guess (eq (point) lim)))
      (funcall (if back 're-search-backward 're-search-forward)
	       ffap-next-regexp lim 'move)
      (setq guess (ffap-guesser)))
    ;; Go to end, so we do not get same guess twice:
    (goto-char (nth (if back 0 1) ffap-string-at-point-region))
    (setq ffap-next-guess guess)))

;;;###autoload
(defun ffap-next (&optional back wrap)
342
  "Search buffer for next file or URL, and run ffap.
Richard M. Stallman's avatar
Richard M. Stallman committed
343 344 345 346
Optional argument BACK says to search backwards.
Optional argument WRAP says to try wrapping around if necessary.
Interactively: use a single prefix to search backwards,
double prefix to wrap forward, triple to wrap backwards.
347
Actual search is done by `ffap-next-guess'."
Richard M. Stallman's avatar
Richard M. Stallman committed
348 349 350 351 352 353 354 355 356 357 358 359 360 361
  (interactive
   (cdr (assq (prefix-numeric-value current-prefix-arg)
	      '((1) (4 t) (16 nil t) (64 t t)))))
  (let ((pt (point))
	(guess (ffap-next-guess back)))
    ;; Try wraparound if necessary:
    (and (not guess) wrap
	 (goto-char (if back (point-max) (point-min)))
	 (setq guess (ffap-next-guess back pt)))
    (if guess
	(progn
	  (sit-for 0)			; display point movement
	  (find-file-at-point (ffap-prompter guess)))
      (goto-char pt)			; restore point
362
      (message "No %sfiles or URL's found"
Richard M. Stallman's avatar
Richard M. Stallman committed
363 364 365
	       (if wrap "" "more ")))))

(defun ffap-next-url (&optional back wrap)
366
  "Like `ffap-next', but search with `ffap-url-regexp'."
Richard M. Stallman's avatar
Richard M. Stallman committed
367 368 369 370 371 372 373
  (interactive)
  (let ((ffap-next-regexp ffap-url-regexp))
    (if (interactive-p)
	(call-interactively 'ffap-next)
      (ffap-next back wrap))))


374
;;; Machines (`ffap-machine-p'):
Richard M. Stallman's avatar
Richard M. Stallman committed
375 376 377 378

;; I cannot decide a "best" strategy here, so these are variables.  In
;; particular, if `Pinging...' is broken or takes too long on your
;; machine, try setting these all to accept or reject.
379
(defcustom ffap-machine-p-local 'reject	; this happens often
Karl Heuer's avatar
Karl Heuer committed
380
  "*What `ffap-machine-p' does with hostnames that have no domain.
381
Value should be a symbol, one of `ping', `accept', and `reject'."
382 383 384 385
  :type '(choice (const ping)
		 (const accept)
		 (const reject))
  :group 'ffap)
Karl Heuer's avatar
Karl Heuer committed
386 387 388 389
(defcustom ffap-machine-p-known 'ping	; `accept' for higher speed
  "*What `ffap-machine-p' does with hostnames that have a known domain.
Value should be a symbol, one of `ping', `accept', and `reject'.
See `mail-extr.el' for the known domains."
390 391 392 393 394
  :type '(choice (const ping)
		 (const accept)
		 (const reject))
  :group 'ffap)
(defcustom ffap-machine-p-unknown 'reject
Karl Heuer's avatar
Karl Heuer committed
395 396 397
  "*What `ffap-machine-p' does with hostnames that have an unknown domain.
Value should be a symbol, one of `ping', `accept', and `reject'.
See `mail-extr.el' for the known domains."
398 399 400 401
  :type '(choice (const ping)
		 (const accept)
		 (const reject))
  :group 'ffap)
402 403 404 405

(defun ffap-what-domain (domain)
  ;; Like what-domain in mail-extr.el, returns string or nil.
  (require 'mail-extr)
406 407 408
  (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains")
		(ffap-soft-value "all-top-level-domains")))) ; XEmacs
    (and ob (get (intern-soft (downcase domain) ob) 'domain-name))))
409 410 411 412 413 414 415

(defun ffap-machine-p (host &optional service quiet strategy)
  "Decide whether HOST is the name of a real, reachable machine.
Depending on the domain (none, known, or unknown), follow the strategy
named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
or `ffap-machine-p-unknown'.  Pinging uses `open-network-stream'.
Optional SERVICE specifies the port used \(default \"discard\"\).
Richard M. Stallman's avatar
Richard M. Stallman committed
416
Optional QUIET flag suppresses the \"Pinging...\" message.
417
Optional STRATEGY overrides the three variables above.
Richard M. Stallman's avatar
Richard M. Stallman committed
418
Returned values:
419 420 421 422 423 424 425 426 427 428
 t      means that HOST answered.
'accept means the relevant variable told us to accept.
\"mesg\"  means HOST exists, but does not respond for some reason."
  ;; Try some (Emory local):
  ;; (ffap-machine-p "ftp" nil nil 'ping)
  ;; (ffap-machine-p "nonesuch" nil nil 'ping)
  ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
  ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
  ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
  ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
Richard M. Stallman's avatar
Richard M. Stallman committed
429
  (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
430
	  (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
Richard M. Stallman's avatar
Richard M. Stallman committed
431 432 433 434
      nil
    (let* ((domain
	    (and (string-match "\\.[^.]*$" host)
		 (downcase (substring host (1+ (match-beginning 0))))))
435 436 437 438 439 440
	   (what-domain (if domain (ffap-what-domain domain) "Local")))
      (or strategy
	  (setq strategy
		(cond ((not domain) ffap-machine-p-local)
		      ((not what-domain) ffap-machine-p-unknown)
		      (t ffap-machine-p-known))))
Richard M. Stallman's avatar
Richard M. Stallman committed
441 442 443
      (cond
       ((eq strategy 'accept) 'accept)
       ((eq strategy 'reject) nil)
444
       ((not (fboundp 'open-network-stream)) nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
445 446 447
       ;; assume (eq strategy 'ping)
       (t
	(or quiet
448 449
	    (if (stringp what-domain)
		(message "Pinging %s (%s)..." host what-domain)
Richard M. Stallman's avatar
Richard M. Stallman committed
450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472
	      (message "Pinging %s ..." host)))
	(condition-case error
	    (progn
	      (delete-process
	       (open-network-stream
		"ffap-machine-p" nil host (or service "discard")))
	      t)
	  (error
	   (let ((mesg (car (cdr error))))
	     (cond
	      ;; v18:
	      ((string-match "^Unknown host" mesg) nil)
	      ((string-match "not responding$" mesg) mesg)
	      ;; v19:
	      ;; (file-error "connection failed" "permission denied"
	      ;;             "nonesuch" "ffap-machine-p")
	      ;; (file-error "connection failed" "host is unreachable"
	      ;;	     "gopher.house.gov" "ffap-machine-p")
	      ;; (file-error "connection failed" "address already in use"
	      ;;	     "ftp.uu.net" "ffap-machine-p")
	      ((equal mesg "connection failed")
	       (if (equal (nth 2 error) "permission denied")
		   nil			; host does not exist
473
		 ;; Other errors mean the host exists:
Richard M. Stallman's avatar
Richard M. Stallman committed
474 475 476 477
		 (nth 2 error)))
	      ;; Could be "Unknown service":
	      (t (signal (car error) (cdr error))))))))))))

478 479 480

;;; Possibly Remote Resources:

Richard M. Stallman's avatar
Richard M. Stallman committed
481
(defun ffap-replace-file-component (fullname name)
482 483 484 485 486 487 488 489 490 491 492
  "In remote FULLNAME, replace path with NAME.  May return nil."
  ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
  (let (found)
    (mapcar
     (function (lambda (sym) (and (fboundp sym) (setq found sym))))
     '(
       efs-replace-path-component
       ange-ftp-replace-path-component
       ange-ftp-replace-name-component
       ))
    (and found
Richard M. Stallman's avatar
Richard M. Stallman committed
493
	 (fset 'ffap-replace-file-component found)
494
	 (funcall found fullname name))))
Richard M. Stallman's avatar
Richard M. Stallman committed
495
;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new")
496

497
(defun ffap-file-suffix (file)
Karl Heuer's avatar
Karl Heuer committed
498
  "Return trailing `.foo' suffix of FILE, or nil if none."
499 500 501 502 503 504 505 506 507 508 509
  (let ((pos (string-match "\\.[^./]*\\'" file)))
    (and pos (substring file pos nil))))

(defvar ffap-compression-suffixes '(".gz" ".Z")	; .z is mostly dead
  "List of suffixes tried by `ffap-file-exists-string'.")

(defun ffap-file-exists-string (file &optional nomodify)
  ;; Early jka-compr versions modified file-exists-p to return the
  ;; filename, maybe modified by adding a suffix like ".gz".  That
  ;; broke the interface of file-exists-p, so it was later dropped.
  ;; Here we document and simulate the old behavior.
Karl Heuer's avatar
Karl Heuer committed
510
  "Return FILE (maybe modified) if the file exists, else nil.
511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527
When using jka-compr (a.k.a. `auto-compression-mode'), the returned
name may have a suffix added from `ffap-compression-suffixes'.
The optional NOMODIFY argument suppresses the extra search."
  (cond
   ((not file) nil)			; quietly reject nil
   ((file-exists-p file) file)		; try unmodified first
   ;; three reasons to suppress search:
   (nomodify nil)
   ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil)
   ((member (ffap-file-suffix file) ffap-compression-suffixes) nil)
   (t					; ok, do the search
    (let ((list ffap-compression-suffixes) try ret)
      (while list
	(if (file-exists-p (setq try (concat file (car list))))
	    (setq ret try list nil)
	  (setq list (cdr list))))
      ret))))
528

Richard M. Stallman's avatar
Richard M. Stallman committed
529
(defun ffap-file-remote-p (filename)
Karl Heuer's avatar
Karl Heuer committed
530
  "If FILENAME looks remote, return it (maybe slightly improved)."
Richard M. Stallman's avatar
Richard M. Stallman committed
531
  ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
Richard M. Stallman's avatar
Richard M. Stallman committed
532
  ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir")
533
  ;; (ffap-file-remote-p "/ffap.el:80")
Richard M. Stallman's avatar
Richard M. Stallman committed
534 535
  (or (and ffap-ftp-regexp
	   (string-match ffap-ftp-regexp filename)
Richard M. Stallman's avatar
Richard M. Stallman committed
536 537
	   ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing
	   ;; practice of advertising ftp files as "host.dom://filename".
Richard M. Stallman's avatar
Richard M. Stallman committed
538
	   (if (string-match "//" filename)
539 540 541
	       ;; (replace-match "/" nil nil filename)
	       (concat (substring filename 0 (1+ (match-beginning 0)))
		       (substring filename (match-end 0)))
Richard M. Stallman's avatar
Richard M. Stallman committed
542 543 544 545 546 547
	     filename))
      (and ffap-rfs-regexp
	   (string-match ffap-rfs-regexp filename)
	   filename)))

(defun ffap-machine-at-point nil
548 549
  "Return machine name at point if it exists, or nil."
  (let ((mach (ffap-string-at-point 'machine)))
Richard M. Stallman's avatar
Richard M. Stallman committed
550 551
    (and (ffap-machine-p mach) mach)))

Richard M. Stallman's avatar
Richard M. Stallman committed
552
(defsubst ffap-host-to-filename (host)
553
  "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
554
Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
555 556 557 558 559 560 561 562
  (if (equal host "localhost")
      ""
    (let ((user ffap-ftp-default-user))
      ;; Avoid including the user if it is same as default:
      (if (or (equal user (ffap-soft-value "ange-ftp-default-user"))
	      (equal user (ffap-soft-value "efs-default-user")))
	  (setq user nil))
      (concat "/" user (and user "@") host ":"))))
563

Richard M. Stallman's avatar
Richard M. Stallman committed
564
(defun ffap-fixup-machine (mach)
Richard M. Stallman's avatar
Richard M. Stallman committed
565
  ;; Convert a hostname into an url, an ftp file name, or nil.
Richard M. Stallman's avatar
Richard M. Stallman committed
566 567
  (cond
   ((not (and ffap-url-regexp (stringp mach))) nil)
568
   ;; gopher.well.com
Richard M. Stallman's avatar
Richard M. Stallman committed
569 570
   ((string-match "\\`gopher[-.]" mach)	; or "info"?
    (concat "gopher://" mach "/"))
571
   ;; www.ncsa.uiuc.edu
Richard M. Stallman's avatar
Richard M. Stallman committed
572 573 574
   ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
    (concat "http://" mach "/"))
   ;; More cases?  Maybe "telnet:" for archie?
Richard M. Stallman's avatar
Richard M. Stallman committed
575
   (ffap-ftp-regexp (ffap-host-to-filename mach))
Richard M. Stallman's avatar
Richard M. Stallman committed
576 577
   ))

578 579 580 581 582 583
(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
  "Strings not matching this fail `ffap-newsgroup-p'.")
(defvar ffap-newsgroup-heads		; entirely inadequate
  '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
  "Used by `ffap-newsgroup-p' if gnus is not running.")

Richard M. Stallman's avatar
Richard M. Stallman committed
584 585 586 587 588 589 590 591 592 593 594 595 596
(defun ffap-newsgroup-p (string)
  "Return STRING if it looks like a newsgroup name, else nil."
  (and
   (string-match ffap-newsgroup-regexp string)
   (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb))
	 (heads ffap-newsgroup-heads)
	 htb ret)
     (while htbs
       (setq htb (car htbs) htbs (cdr htbs))
       (condition-case nil
	   (progn
	     ;; errs: htb symbol may be unbound, or not a hash-table.
	     ;; gnus-gethash is just a macro for intern-soft.
597 598
	     (and (symbol-value htb)
		  (intern-soft string (symbol-value htb))
Richard M. Stallman's avatar
Richard M. Stallman committed
599
		  (setq ret string htbs nil))
600
	     ;; If we made it this far, gnus is running, so ignore "heads":
Richard M. Stallman's avatar
Richard M. Stallman committed
601 602 603 604 605 606 607
	     (setq heads nil))
	 (error nil)))
     (or ret (not heads)
	 (let ((head (string-match "\\`\\([a-z]+\\)\\." string)))
	   (and head (setq head (substring string 0 (match-end 1)))
		(member head heads)
		(setq ret string))))
608
     ;; Is there ever a need to modify string as a newsgroup name?
Richard M. Stallman's avatar
Richard M. Stallman committed
609 610
     ret)))

611 612
(defsubst ffap-url-p (string)
  "If STRING looks like an url, return it (maybe improved), else nil."
Richard M. Stallman's avatar
Richard M. Stallman committed
613 614 615 616 617
  (let ((case-fold-search t))
    (and ffap-url-regexp (string-match ffap-url-regexp string)
	 ;; I lied, no improvement:
	 string)))

618 619 620
;; Broke these out of ffap-fixup-url, for use of ffap-url package.
(defsubst ffap-url-unwrap-local (url)
  "Return URL as a local file, or nil.  Ignores `ffap-url-regexp'."
Richard M. Stallman's avatar
Richard M. Stallman committed
621 622
  (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
       (substring url (1+ (match-end 1)))))
623 624
(defsubst ffap-url-unwrap-remote (url)
  "Return URL as a remote file, or nil.  Ignores `ffap-url-regexp'."
Richard M. Stallman's avatar
Richard M. Stallman committed
625 626
  (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
       (concat
Richard M. Stallman's avatar
Richard M. Stallman committed
627
	(ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
Richard M. Stallman's avatar
Richard M. Stallman committed
628
	(substring url (match-beginning 3) (match-end 3)))))
629
;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
Richard M. Stallman's avatar
Richard M. Stallman committed
630 631

(defun ffap-fixup-url (url)
632
  "Clean up URL and return it, maybe as a file name."
Richard M. Stallman's avatar
Richard M. Stallman committed
633 634 635 636 637
  (cond
   ((not (stringp url)) nil)
   ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
   ((and ffap-url-unwrap-remote ffap-ftp-regexp
	 (ffap-url-unwrap-remote url)))
638 639 640
   ((fboundp 'url-normalize-url)	; may autoload url (part of w3)
    (url-normalize-url url))
   (url)))
Richard M. Stallman's avatar
Richard M. Stallman committed
641 642


Richard M. Stallman's avatar
Richard M. Stallman committed
643
;;; File Name Handling:
Richard M. Stallman's avatar
Richard M. Stallman committed
644
;;
645
;; The upcoming ffap-alist actions need various utilities to prepare
Richard M. Stallman's avatar
Richard M. Stallman committed
646
;; and search directories.  Too many features here.
647 648 649 650 651 652 653 654 655

;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
;; (defun ffap-splice (func inlist)
;;  "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
;;  (let* ((head (cons 17 nil)) (last head))
;;    (while inlist
;;      (setcdr last (funcall func (car inlist)))
;;      (setq last (ffap-last last) inlist (cdr inlist)))
;;    (cdr head)))
Richard M. Stallman's avatar
Richard M. Stallman committed
656 657

(defun ffap-list-env (env &optional empty)
658 659 660 661 662 663 664 665
  "Return a list of strings parsed from environment variable ENV.
Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
also is substituted for the first empty-string component, if there is one.
Uses `path-separator' to separate the path into substrings."
  ;; We cannot use parse-colon-path (files.el), since it kills
  ;; "//" entries using file-name-as-directory.
  ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
  ;; in ff-paths and bib-cite.  The EMPTY arg may help mimic kpathsea.
Richard M. Stallman's avatar
Richard M. Stallman committed
666 667
  (if (or empty (getenv env))		; should return something
      (let ((start 0) match dir ret)
668
	(setq env (concat (getenv env) path-separator))
669
	(while (setq match (string-match path-separator env start))
Richard M. Stallman's avatar
Richard M. Stallman committed
670 671 672 673 674
	  (setq dir (substring env start match) start (1+ match))
	  ;;(and (file-directory-p dir) (not (member dir ret)) ...)
	  (setq ret (cons dir ret)))
	(setq ret (nreverse ret))
	(and empty (setq match (member "" ret))
675
	     (progn			; allow string or list here
Richard M. Stallman's avatar
Richard M. Stallman committed
676 677 678 679 680
	       (setcdr match (append (cdr-safe empty) (cdr match)))
	       (setcar match (or (car-safe empty) empty))))
	ret)))

(defun ffap-reduce-path (path)
681
  "Remove duplicates and non-directories from PATH list."
Richard M. Stallman's avatar
Richard M. Stallman committed
682 683 684
  (let (ret tem)
    (while path
      (setq tem path path (cdr path))
685
      (if (equal (car tem) ".") (setcar tem ""))
Richard M. Stallman's avatar
Richard M. Stallman committed
686 687 688 689 690
      (or (member (car tem) ret)
	  (not (file-directory-p (car tem)))
	  (progn (setcdr tem ret) (setq ret tem))))
    (nreverse ret)))

691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731
(defun ffap-all-subdirs (dir &optional depth)
  "Return list all subdirectories under DIR, starting with itself.
Directories beginning with \".\" are ignored, and directory symlinks
are listed but never searched (to avoid loops).
Optional DEPTH limits search depth."
  (and (file-exists-p dir)
       (ffap-all-subdirs-loop (expand-file-name dir) (or depth -1))))

(defun ffap-all-subdirs-loop (dir depth) ; internal
  (setq depth (1- depth))
  (cons dir
	(and (not (eq depth -1))
	     (apply 'nconc
		    (mapcar
		     (function
		      (lambda (d)
			(cond
			 ((not (file-directory-p d)) nil)
			 ((file-symlink-p d) (list d))
			 (t (ffap-all-subdirs-loop d depth)))))
		     (directory-files dir t "\\`[^.]")
		     )))))

(defvar ffap-kpathsea-depth 1
  "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
Set to 0 to avoid all searching, or nil for no limit.")

(defun ffap-kpathsea-expand-path (path)
  "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs.
The subdirs begin with the original directory, and the depth of the
search is bounded by `ffap-kpathsea-depth'.  This is intended to mimic
kpathsea, a library used by some versions of TeX."
  (apply 'nconc
	 (mapcar
	  (function
	   (lambda (dir)
	     (if (string-match "[^/]//\\'" dir)
		 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
	       (list dir))))
	  path)))

732
(defun ffap-locate-file (file &optional nosuffix path dir-ok)
Richard M. Stallman's avatar
Richard M. Stallman committed
733
  ;; The current version of locate-library could almost replace this,
734
  ;; except it does not let us override the suffix list.  The
735
  ;; compression-suffixes search moved to ffap-file-exists-string.
736 737 738 739 740
  "A generic path-searching function, mimics `load' by default.
Returns path to file that \(load FILE\) would load, or nil.
Optional NOSUFFIX, if nil or t, is like the fourth argument
for load: whether to try the suffixes (\".elc\" \".el\" \"\").
If a nonempty list, it is a list of suffixes to try instead.
741 742 743 744 745 746
Optional PATH is a list of directories instead of `load-path'.
Optional DIR-OK means that returning a directory is allowed,
DIR-OK is already implicit if FILE looks like a directory.

This uses ffap-file-exists-string, which may try adding suffixes from
`ffap-compression-suffixes'."
747
  (or path (setq path load-path))
748
  (or dir-ok (setq dir-ok (equal "" (file-name-nondirectory file))))
749 750 751 752 753 754 755
  (if (file-name-absolute-p file)
      (setq path (list (file-name-directory file))
	    file (file-name-nondirectory file)))
  (let ((suffixes-to-try
	 (cond
	  ((consp nosuffix) nosuffix)
	  (nosuffix '(""))
756 757 758 759 760 761 762 763 764 765 766 767 768
	  (t '(".elc" ".el" ""))))
	suffixes try found)
    (while path
      (setq suffixes suffixes-to-try)
      (while suffixes
	(setq try (ffap-file-exists-string
		   (expand-file-name
		    (concat file (car suffixes)) (car path))))
	(if (and try (or dir-ok (not (file-directory-p try))))
	    (setq found try suffixes nil path nil)
	  (setq suffixes (cdr suffixes))))
      (setq path (cdr path)))
    found))
769 770 771 772 773 774 775 776


;;; Action List (`ffap-alist'):
;;
;; These search actions depend on the major-mode or regexps matching
;; the current name.  The little functions and their variables are
;; deferred to the next section, at some loss of "code locality".  A
;; good example of featuritis.  Trim this list for speed.
Richard M. Stallman's avatar
Richard M. Stallman committed
777 778

(defvar ffap-alist
779
  '(
780 781 782 783 784 785
    ("" . ffap-completable)		; completion, slow on some systems
    ("\\.info\\'" . ffap-info)		; gzip.info
    ("\\`info/" . ffap-info-2)		; info/emacs
    ("\\`[-a-z]+\\'" . ffap-info-3)	; (emacs)Top [only in the parentheses]
    ("\\.elc?\\'" . ffap-el)		; simple.el, simple.elc
    (emacs-lisp-mode . ffap-el-mode)	; rmail, gnus, simple, custom
786
    ;; (lisp-interaction-mode . ffap-el-mode) ; maybe
787 788 789 790 791 792 793 794 795
    (finder-mode . ffap-el-mode)	; type {C-h p} and try it
    (help-mode . ffap-el-mode)		; maybe useful
    (c++-mode . ffap-c-mode)		; search ffap-c-path
    (cc-mode . ffap-c-mode)		; same
    ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h
    (fortran-mode . ffap-fortran-mode)	; FORTRAN requested by MDB
    ("\\.[fF]\\'" . ffap-fortran-mode)
    (tex-mode . ffap-tex-mode)		; search ffap-tex-path
    (latex-mode . ffap-latex-mode)	; similar
796
    ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex)
797 798 799
    ("\\.bib\\'" . ffap-bib)		; search ffap-bib-path
    ("\\`\\." . ffap-home)		; .emacs, .bashrc, .profile
    ("\\`~/" . ffap-lcd)		; |~/misc/ffap.el.Z|
800
    ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)"	; no $
801 802 803
     . ffap-rfc)			; "100% RFC2100 compliant"
    (dired-mode . ffap-dired)		; maybe in a subdirectory
    )
804 805 806 807 808 809 810 811
  "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
If string NAME at point (maybe \"\") is not a file or url, these pairs
specify actions to try creating such a string.  A pair matches if either
  KEY is a symbol, and it equals `major-mode', or
  KEY is a string, it should matches NAME as a regexp.
On a match, \(FUNCTION NAME\) is called and should return a file, an
url, or nil. If nil, search the alist for further matches.")

Richard M. Stallman's avatar
Richard M. Stallman committed
812
(put 'ffap-alist 'risky-local-variable t)
813

814 815 816 817 818 819 820 821 822 823 824 825 826 827 828
;; Example `ffap-alist' modifications:
;;
;; (setq ffap-alist                   ; remove a feature in `ffap-alist'
;;	 (delete (assoc 'c-mode ffap-alist) ffap-alist))
;;
;; (setq ffap-alist                   ; add something to `ffap-alist'
;;	 (cons
;;	  (cons "^YSN[0-9]+$"
;;		(defun ffap-ysn (name)
;;		  (concat
;;		   "http://www.physics.uiuc.edu/"
;;                 "ysn/httpd/htdocs/ysnarchive/issuefiles/"
;;		   (substring name 3) ".html")))
;;	  ffap-alist))

829

830 831 832 833 834 835 836 837 838 839
;;; Action Definitions:
;;
;; Define various default members of `ffap-alist'.

(defun ffap-completable (name)
  (let* ((dir (or (file-name-directory name) default-directory))
	 (cmp (file-name-completion (file-name-nondirectory name) dir)))
    (and cmp (concat dir cmp))))

(defun ffap-home (name) (ffap-locate-file name t '("~")))
840 841

(defun ffap-info (name)
842
  (ffap-locate-file
843 844 845
   name '("" ".info")
   (or (ffap-soft-value "Info-directory-list")
       (ffap-soft-value "Info-default-directory-list")
846
       )))
847 848 849 850

(defun ffap-info-2 (name) (ffap-info (substring name 5)))

(defun ffap-info-3 (name)
851
  ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
852 853
  (and (equal (ffap-string-around) "()") (ffap-info name)))

854
(defun ffap-el (name) (ffap-locate-file name t))
855 856

(defun ffap-el-mode (name)
857 858
  ;; If name == "foo.el" we will skip it, since ffap-el already
  ;; searched for it once.  (This assumes the default ffap-alist.)
859
  (and (not (string-match "\\.el\\'" name))
860 861 862 863 864 865 866 867 868 869 870 871
       (ffap-locate-file name '(".el"))))

(defvar ffap-c-path
  ;; Need smarter defaults here!  Suggestions welcome.
  '("/usr/include" "/usr/local/include"))
(defun ffap-c-mode (name)
  (ffap-locate-file name t ffap-c-path))

(defvar ffap-fortran-path '("../include" "/usr/include"))

(defun ffap-fortran-mode (name)
  (ffap-locate-file name t ffap-fortran-path))
872 873 874 875 876

(defvar ffap-tex-path
  t				; delayed initialization
  "Path where `ffap-tex-mode' looks for tex files.
If t, `ffap-tex-init' will initialize this when needed.")
Richard M. Stallman's avatar
Richard M. Stallman committed
877

878 879 880
(defun ffap-tex-init nil
  ;; Compute ffap-tex-path if it is now t.
  (and (eq t ffap-tex-path)
881
       ;; this may be slow, so say something
882 883 884
       (message "Initializing ffap-tex-path ...")
       (setq ffap-tex-path
	     (ffap-reduce-path
885 886 887 888 889 890 891 892 893 894
	      (cons
	       "."
	       (ffap-kpathsea-expand-path
		(append
		 (ffap-list-env "TEXINPUTS")
		 ;; (ffap-list-env "BIBINPUTS")
		 (ffap-soft-value
		  "TeX-macro-global"	; AUCTeX
		  '("/usr/local/lib/tex/macros"
		    "/usr/local/lib/tex/inputs")))))))))
895 896 897

(defun ffap-tex-mode (name)
  (ffap-tex-init)
898
  (ffap-locate-file name '(".tex" "") ffap-tex-path))
899 900 901

(defun ffap-latex-mode (name)
  (ffap-tex-init)
902 903
  ;; only rare need for ""
  (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
904 905 906

(defun ffap-tex (name)
  (ffap-tex-init)
907 908 909 910 911 912 913 914 915 916
  (ffap-locate-file name t ffap-tex-path))

(defvar ffap-bib-path
  (ffap-list-env "BIBINPUTS"
		 (ffap-reduce-path
		  '(
		    ;; a few wild guesses, need better
		    "/usr/local/lib/tex/macros/bib" ; Solaris?
		    "/usr/lib/texmf/bibtex/bib"	; Linux?
		    ))))
917 918

(defun ffap-bib (name)
919
  (ffap-locate-file name t ffap-bib-path))
920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947

(defun ffap-dired (name)
  (let ((pt (point)) dir try)
    (save-excursion
      (and (progn
	     (beginning-of-line)
	     (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
	   (re-search-backward "^ *$" nil t)
	   (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t)
	   (file-exists-p
	    (setq try
		  (expand-file-name
		   name
		   (buffer-substring
		    (match-beginning 1) (match-end 1)))))
	   try))))

;; Maybe a "Lisp Code Directory" reference:
(defun ffap-lcd (name)
  (and
   (or
    ;; lisp-dir-apropos output buffer:
    (string-match "Lisp Code Dir" (buffer-name))
    ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
    ;; or maybe the holy LCD-Datafile itself:
    (member (ffap-string-around) '("||" "|\n")))
   (concat
    ;; lispdir.el may not be loaded yet:
Richard M. Stallman's avatar
Richard M. Stallman committed
948
    (ffap-host-to-filename
949 950 951 952 953 954 955 956
     (ffap-soft-value "elisp-archive-host"
		      "archive.cis.ohio-state.edu"))
    (file-name-as-directory
     (ffap-soft-value "elisp-archive-directory"
		      "/pub/gnu/emacs/elisp-archive/"))
    (substring name 2))))

(defvar ffap-rfc-path
957
  (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt"))
958 959 960 961

(defun ffap-rfc (name)
  (format ffap-rfc-path
	  (substring name (match-beginning 1) (match-end 1))))
962

Richard M. Stallman's avatar
Richard M. Stallman committed
963 964 965 966 967

;;; At-Point Functions:

(defvar ffap-string-at-point-mode-alist
  '(
968
    ;; The default, used when the `major-mode' is not found.
Richard M. Stallman's avatar
Richard M. Stallman committed
969 970 971
    ;; Slightly controversial decisions:
    ;; * strip trailing "@" and ":"
    ;; * no commas (good for latex)
972
    (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:")
973
    ;; An url, or maybe a email/news message-id:
974
    (url "--:=&?$+@-Z_a-z~#,%;*" "^A-Za-z0-9" ":;.,!?")
975 976 977 978 979 980
    ;; Find a string that does *not* contain a colon:
    (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
    ;; A machine:
    (machine "-a-zA-Z0-9." "" ".")
    ;; Mathematica paths: allow backquotes
    (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
Richard M. Stallman's avatar
Richard M. Stallman committed
981
    )
982
  "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
Karl Heuer's avatar
Karl Heuer committed
983 984
possibly a major-mode name, or one of the symbol
`file', `url', `machine', and `nocolon'.
985 986 987 988
`ffap-string-at-point' uses the data fields as follows:
1. find a maximal string of CHARS around point,
2. strip BEG chars before point from the beginning,
3. Strip END chars after point from the end.")
Richard M. Stallman's avatar
Richard M. Stallman committed
989 990 991

(defvar ffap-string-at-point nil
  ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
992 993 994 995
  "Last string returned by `ffap-string-at-point'.")

(defun ffap-string-at-point (&optional mode)
  "Return a string of characters from around point.
Karl Heuer's avatar
Karl Heuer committed
996
MODE (defaults to value of `major-mode') is a symbol used to look up string
997
syntax parameters in `ffap-string-at-point-mode-alist'.
Karl Heuer's avatar
Karl Heuer committed
998
If MODE is not found, we use `file' instead of MODE.
999
If the region is active, return a string from the region.
1000 1001 1002 1003 1004 1005 1006
Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
  (let* ((args
	  (cdr
	   (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
	       (assq 'file ffap-string-at-point-mode-alist))))
	 (pt (point))
	 (str
1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019
	  (if (and transient-mark-mode mark-active)
	      (buffer-substring
	       (setcar ffap-string-at-point-region (region-beginning))
	       (setcar (cdr ffap-string-at-point-region) (region-end)))
	    (buffer-substring
	     (save-excursion
	       (skip-chars-backward (car args))
	       (skip-chars-forward (nth 1 args) pt)
	       (setcar ffap-string-at-point-region (point)))
	     (save-excursion
	       (skip-chars-forward (car args))
	       (skip-chars-backward (nth 2 args) pt)
	       (setcar (cdr ffap-string-at-point-region) (point)))))))
1020
    (set-text-properties 0 (length str) nil str)
1021
    (setq ffap-string-at-point str)))
Richard M. Stallman's avatar
Richard M. Stallman committed
1022 1023 1024

(defun ffap-string-around nil
  ;; Sometimes useful to decide how to treat a string.
1025 1026
  "Return string of two chars around last `ffap-string-at-point'.
Assumes the buffer has not changed."
Richard M. Stallman's avatar
Richard M. Stallman committed
1027 1028 1029 1030 1031 1032 1033 1034 1035 1036
  (save-excursion
    (format "%c%c"
	    (progn
	      (goto-char (car ffap-string-at-point-region))
	      (preceding-char))		; maybe 0
	    (progn
	      (goto-char (nth 1 ffap-string-at-point-region))
	      (following-char))		; maybe 0
	    )))

1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047
(defun ffap-copy-string-as-kill (&optional mode)
  ;; Requested by MCOOK.  Useful?
  "Call `ffap-string-at-point', and copy result to `kill-ring'."
  (interactive)
  (let ((str (ffap-string-at-point mode)))
    (if (equal "" str)
	(message "No string found around point.")
      (kill-new str)
      ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
      (message "Copied to kill ring: %s"  str))))