Mercurial > hg > xemacs-beta

comparison lisp/utils/browse-url.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children bcdc7deadc19
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; browse-url.el --- ask a WWW browser to load a URL
2
3 ;; Copyright 1995 Free Software Foundation, Inc.
4
5 ;; Author: Denis Howe <dbh@doc.ic.ac.uk>
6 ;; Maintainer: Denis Howe <dbh@doc.ic.ac.uk>
7 ;; Created: 03 Apr 1995
8 ;; Version: 0.38 18 Jun 1996
9 ;; Keywords: hypertext
10 ;; X-Home page: http://wombat.doc.ic.ac.uk/
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published
16 ;; by the Free Software Foundation; either version 1, or (at your
17 ;; option) any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful, but
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;; General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;;; Commentary:
30
31 ;; The latest version of this package should be available from
32 ;; <URL:http://wombat.doc.ic.ac.uk/emacs/browse-url.el>.
33
34 ;; This package provides functions which read a URL (Uniform Resource
35 ;; Locator) from the minibuffer, defaulting to the URL around point,
36 ;; and ask a World-Wide Web browser to load it. It can also load the
37 ;; URL associated with the current buffer. Different browsers use
38 ;; different methods of remote control so there is one function for
39 ;; each supported browser. If the chosen browser is not running, it
40 ;; is started. Currently there is support for:
41
42 ;; Function Browser Earliest version
43 ;; browse-url-netscape Netscape 1.1b1
44 ;; browse-url-mosaic XMosaic <= 2.4
45 ;; browse-url-cci XMosaic 2.5
46 ;; browse-url-w3 w3 0
47 ;; browse-url-iximosaic IXI Mosaic ?
48 ;; browse-url-lynx-* Lynx 0
49 ;; browse-url-grail Grail 0.3b1
50
51 ;; Note that versions of Netscape before 1.1b1 did not have remote
52 ;; control. <URL:http://www.netscape.com/newsref/std/x-remote.html>
53 ;; and <URL:http://www.netscape.com/info/APIs/>.
54
55 ;; Netscape can cache Web pages so it may be necessary to tell it to
56 ;; reload the current page if it has changed (e.g. if you have edited
57 ;; it). There is currently no perfect automatic solution to this.
58
59 ;; Netscape allows you to specify the id of the window you want to
60 ;; control but which window DO you want to control and how do you
61 ;; discover its id?
62
63 ;; If using XMosaic before version 2.5, check the definition of
64 ;; browse-url-usr1-signal below.
65 ;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html>
66
67 ;; XMosaic version 2.5 introduced Common Client Interface allowing you
68 ;; to control mosaic through Unix sockets.
69 ;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/CCI/cci-spec.html>
70
71 ;; William M. Perry's excellent "w3" WWW browser for
72 ;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
73 ;; has a function w3-follow-url-at-point, but that
74 ;; doesn't let you edit the URL like browse-url.
75
76 ;; I recommend Nelson Minar <nelson@santafe.edu>'s excellent
77 ;; html-helper-mode.el for editing HTML and thank Nelson for
78 ;; his many useful comments on this code.
79 ;; <URL:http://www.santafe.edu/~nelson/hhm-beta/>
80
81 ;; This package generalises function html-previewer-process in Marc
82 ;; Andreessen <marca@ncsa.uiuc.edu>'s html-mode (LCD
83 ;; modes/html-mode.el.Z) and provides better versions of the URL
84 ;; functions in Michelangelo Grigni <mic@cs.ucsd.edu>'s ffap.el
85 ;; (find-file-at-point) <URL:ftp://cs.ucsd.edu:/pub/mic/>. The huge
86 ;; hyperbole package also contains similar functions.
87
88 ;; Grail is the freely available WWW browser implemented in Python, a
89 ;; cool object-oriented freely available interpreted language. Grail
90 ;; 0.3b1 was the first version to have remote control as distributed.
91 ;; For more information on Grail see
92 ;; <URL:http://monty.cnri.reston.va.us/> and for more information on
93 ;; Python see <url:http://www.python.org/>. Grail support in
94 ;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>.
95
96 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97 ;; Help!
98
99 ;; Can you write and test some code for the Macintrash and Windoze
100 ;; Netscape remote control APIs? (See the URL above).
101
102 ;; Do any other browsers have remote control?
103
104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
105 ;; Installation
106
107 ;; Put the following in your ~/.emacs file:
108 ;;
109 ;; (autoload 'browse-url-at-point "browse-url"
110 ;; "Ask a WWW browser to load the URL at or before point." t)
111 ;; (autoload 'browse-url-at-mouse "browse-url"
112 ;; "Ask a WWW browser to load a URL clicked with the mouse." t)
113 ;; (autoload 'browse-url-of-buffer "browse-url"
114 ;; "Ask a WWW browser to display BUFFER." t)
115 ;; (autoload 'browse-url-of-file "browse-url"
116 ;; "Ask a WWW browser to display FILE." t)
117 ;; (autoload 'browse-url-of-dired-file "browse-url"
118 ;; "In Dired, ask a WWW browser to display the file named on this line." t)
119
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121 ;; Usage
122
123 ;; To display the URL at or before point:
124 ;; M-x browse-url-at-point RET
125
126 ;; To display a URL by shift-clicking on it, put this in your ~/.emacs
127 ;; file:
128 ;; (global-set-key [S-mouse-1] 'browse-url-at-mouse)
129
130 ;; To display the current buffer in a web browser:
131 ;; M-x browse-url-of-buffer RET
132
133 ;; In Dired, to display the file named on the current line:
134 ;; M-x browse-url-of-dired-file RET
135
136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
137 ;; Customisation (~/.emacs)
138
139 ;; To see what variables are available for customization, type
140 ;; `M-x set-variable browse-url TAB'.
141
142 ;; Bind the browse-url commands to keys with the `C-c C-z' prefix
143 ;; (as used by html-helper-mode):
144 ;; (global-set-key "\C-c\C-z." 'browse-url-at-point)
145 ;; (global-set-key "\C-c\C-zb" 'browse-url-of-buffer)
146 ;; (global-set-key "\C-c\C-zu" 'browse-url)
147 ;; (global-set-key "\C-c\C-zv" 'browse-url-of-file)
148 ;; (add-hook 'dired-mode-hook
149 ;; (function (lambda ()
150 ;; (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file))))
151
152 ;; Browse URLs in mail messages by clicking mouse-2:
153 ;; (add-hook 'rmail-mode-hook (function (lambda () ; rmail-mode startup
154 ;; (define-key rmail-mode-map [mouse-2] 'browse-url-at-mouse))))
155
156 ;; Browse URLs in Usenet messages by clicking mouse-2:
157 ;; (eval-after-load "gnus"
158 ;; '(define-key gnus-article-mode-map [mouse-2] 'browse-url-at-mouse))
159
160 ;; Use the Emacs w3 browser when not running under X11:
161 ;; (or (eq window-system 'x)
162 ;; (setq browse-url-browser-function 'browse-url-w3))
163
164 ;; To always save modified buffers before displaying the file in a browser:
165 ;; (setq browse-url-save-file t)
166
167 ;; To get round the Netscape caching problem, you could EITHER have
168 ;; write-file in html-helper-mode make Netscape reload the document:
169 ;;
170 ;; (autoload 'browse-url-netscape-reload "browse-url"
171 ;; "Ask a WWW browser to redisplay the current file." t)
172 ;; (add-hook 'html-helper-mode-hook
173 ;; (function (lambda ()
174 ;; (add-hook 'local-write-file-hooks
175 ;; (function (lambda ()
176 ;; (let ((local-write-file-hooks))
177 ;; (save-buffer))
178 ;; (browse-url-netscape-reload)
179 ;; t)) ; => file written by hook
180 ;; t)))) ; append to l-w-f-hooks
181 ;;
182 ;; OR have browse-url-of-file ask Netscape to load and then reload the
183 ;; file:
184 ;;
185 ;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
186
187 ;; You may also want to customise browse-url-netscape-arguments, e.g.
188 ;; (setq browse-url-netscape-arguments '("-install"))
189 ;;
190 ;; or similarly for mosaic.
191
192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
193 ;;; Change Log:
194
195 ;; 0.00 03 Apr 1995 Denis Howe <dbh@doc.ic.ac.uk>
196 ;; Created.
197
198 ;; 0.01 04 Apr 1995
199 ;; All names start with "browse-url-". Added provide.
200
201 ;; 0.02 05 Apr 1995
202 ;; Save file at start of browse-url-of-file.
203 ;; Use start-process instead of start-process-shell-command.
204
205 ;; 0.03 06 Apr 1995
206 ;; Add browse-url-netscape-reload, browse-url-netscape-send.
207 ;; browse-url-of-file save file option.
208
209 ;; 0.04 08 Apr 1995
210 ;; b-u-file-url separate function. Change b-u-filename-alist
211 ;; default.
212
213 ;; 0.05 09 Apr 1995
214 ;; Added b-u-of-file-hook.
215
216 ;; 0.06 11 Apr 1995
217 ;; Improved .emacs suggestions and documentation.
218
219 ;; 0.07 13 Apr 1995
220 ;; Added browse-url-interactive-arg optional prompt.
221
222 ;; 0.08 18 Apr 1995
223 ;; Exclude final "." from browse-url-regexp.
224
225 ;; 0.09 21 Apr 1995
226 ;; Added mouse-set-point to browse-url-interactive-arg.
227
228 ;; 0.10 24 Apr 1995
229 ;; Added Mosaic signal sending variations.
230 ;; Thanks Brian K Servis <servis@ecn.purdue.edu>.
231 ;; Don't use xprop for Netscape.
232
233 ;; 0.11 25 Apr 1995
234 ;; Fix reading of ~/.mosaicpid. Thanks Dag.H.Wanvik@kvatro.no.
235
236 ;; 0.12 27 Apr 1995
237 ;; Interactive prefix arg => URL *after* point.
238 ;; Thanks Michelangelo Grigni <mic@cs.ucsd.edu>.
239 ;; Added IXI Mosaic support.
240 ;; Thanks David Karr <dkarr@nmo.gtegsc.com>.
241
242 ;; 0.13 28 Apr 1995
243 ;; Exclude final [,;] from browse-url-regexp.
244
245 ;; 0.14 02 May 1995
246 ;; Provide browser argument variables.
247
248 ;; 0.15 07 May 1995
249 ;; More Netscape options. Thanks Peter Arius
250 ;; <arius@immd2.informatik.uni-erlangen.de>.
251
252 ;; 0.16 17 May 1995
253 ;; Added browse-url-at-mouse.
254 ;; Thanks Wayne Mesard <wmesard@sgi.com>
255
256 ;; 0.17 27 Jun 1995
257 ;; Renamed browse-url-at-point to browse-url-url-at-point.
258 ;; Added browse-url-at-point.
259 ;; Thanks Jonathan Cano <cano@patch.tandem.com>.
260
261 ;; 0.18 16 Aug 1995
262 ;; Fixed call to browse-url-url-at-point in browse-url-at-point.
263 ;; Thanks Eric Ding <ericding@San-Jose.ate.slb.com>.
264
265 ;; 0.19 24 Aug 1995
266 ;; Improved documentation.
267 ;; Thanks Kevin Rodgers <kevin.rodgers@ihs.com>.
268
269 ;; 0.20 31 Aug 1995
270 ;; browse-url-of-buffer to handle file-less buffers.
271 ;; browse-url-of-dired-file browses current file in dired.
272 ;; Thanks Kevin Rodgers <kevin.rodgers@ihs.com>.
273
274 ;; 0.21 09 Sep 1995
275 ;; XMosaic CCI functions.
276 ;; Thanks Marc Furrer <Marc.Furrer@di.epfl.ch>.
277
278 ;; 0.22 13 Sep 1995
279 ;; Fixed new-window documentation and added to browse-url-cci.
280 ;; Thanks Dilip Sequeira <djs@dcs.ed.ac.uk>.
281
282 ;; 0.23 10 Nov 1995
283 ;; Added b-u-lynx. Thanks Steven L. Baur <steve@miranova.com>.
284
285 ;; 0.24 22 Nov 1995
286 ;; Renamed b-u-netscape command to b-u-netscape-send.
287 ;; Added b-u-netscape-command variable.
288
289 ;; 0.25 03 Dec 1995
290 ;; Added event-buffer and event-point for XEmacs compatibility.
291 ;; Thanks Eric Engstrom <engstrom@src.honeywell.com>
292
293 ;; 0.26 13 Jan 1996
294 ;; Changed b-u-lynx to b-u-lynx-xterm, added b-u-lynx-emacs to
295 ;; run Lynx in an Emacs buffer under terminal-emulator.
296 ;; Thanks Jari Aalto <jaalto@tre.tele.nokia.fi>
297
298 ;; 0.27 27 Feb 1996
299 ;; Changed event-buffer and event-point from macros to functions.
300 ;; Other fixes for byte-compilation.
301
302 ;; 0.28 07 Mar 1996
303 ;; browse-url-lynx-emacs uses term.el instead of terminal.el.
304
305 ;; 0.29 13 Mar 1996
306 ;; Added browse-url-CCI-host. Thanks Greg Marr <gregm@WPI.EDU>.
307
308 ;; 0.30 23 Mar 1996
309 ;; Contact/start Netscape in the background.
310 ;; Thanks Per Abrahamsen <abraham@dina.kvl.dk>
311
312 ;; 0.31 28 Apr 1996
313 ;; Added browse-url command.
314 ;; Added new-window logic to b-u-interactive-arg.
315 ;; b-u-file-url checks for EFS path.
316
317 ;; 0.32 02 May 1996
318 ;; Improved b-u-url-at-point matching to supply missing "http://".
319
320 ;; 0.33 01 Jun 1996
321 ;; Jari Aalto <jaalto@tre.tele.nokia.fi> browse-url-lynx-emacs
322 ;; fix. Thanks Jari.
323
324 ;; 0.34 05 Jun 1996
325 ;; b-u-file-url checks for EFS after alist. Thanks
326 ;; Jens-U H Petersen <petersen@kurims.kyoto-u.ac.jp>
327
328 ;; 0.35 11 Jun 1996
329 ;; Grail support. Thanks Barry A. Warsaw
330 ;; <bwarsaw@anthem.cnri.reston.va.us>.
331
332 ;; 0.36 12 Jun 1996
333 ;; Fixed browse-url-looking-at (I hope).
334
335 ;; 0.37 15 Jun 1996
336 ;; b-u-file-url URL-encodes special chars.
337 ;; Thanks Martin Schwenke <Martin.Schwenke@cs.anu.edu.au>.
338
339 ;; 0.38 17 Jun 1996
340 ;; b-u-file-url encodes fewer chars. Multi-display support for
341 ;; Netscape. Thanks Richard Mlynarik <mly@adoc.xerox.com>
342
343 ;;; Code:
344
345 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
346 ;; Variables
347
348 (eval-when-compile (require 'dired))
349
350 (defvar browse-url-path-regexp
351 "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+"
352 "A regular expression probably matching the host, path or e-mail
353 part of a URL.")
354
355 (defvar browse-url-short-regexp
356 (concat "[-A-Za-z0-9.]+" browse-url-path-regexp)
357 "A regular expression probably matching a URL without an access scheme.
358 Hostname matching is stricter in this case than for
359 ``browse-url-regexp''.")
360
361 (defvar browse-url-regexp
362 (concat
363 "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
364 browse-url-path-regexp)
365 "A regular expression probably matching a complete URL.")
366
367
368 ;;;###autoload
369 (defvar browse-url-browser-function 'browse-url-w3
370 "*Function to display the current buffer in a WWW browser.
371 Used by the `browse-url-at-point', `browse-url-at-mouse', and
372 `browse-url-of-file' commands.")
373
374 (defvar browse-url-netscape-command "netscape"
375 "*The name by which to invoke Netscape.")
376
377 (defvar browse-url-netscape-arguments nil
378 "*A list of strings to pass to Netscape as arguments.")
379
380 (defvar browse-url-new-window-p nil
381 "*If non-nil, always open a new browser window.
382 Passing an interactive argument to \\[browse-url-netscape] or
383 \\[browse-url-cci] reverses the effect of this variable. Requires
384 Netscape version 1.1N or later or XMosaic version 2.5 or later.")
385
386 (defvar browse-url-mosaic-arguments nil
387 "*A list of strings to pass to Mosaic as arguments.")
388
389 (defvar browse-url-filename-alist
390 '(("^/+" . "file:/"))
391 "An alist of (REGEXP . STRING) pairs.
392 Any substring of a filename matching one of the REGEXPs is replaced by
393 the corresponding STRING. All pairs are applied in the order given.
394 The default value prepends `file:' to any path beginning with `/'.
395 Used by the `browse-url-of-file' command.")
396
397 (defvar browse-url-save-file nil
398 "If non-nil, save the buffer before displaying its file.
399 Used by the `browse-url-of-file' command.")
400
401 (defvar browse-url-of-file-hook nil
402 "A hook to be run with run-hook after `browse-url-of-file' has asked
403 a browser to load a file.
404
405 Set this to `browse-url-netscape-reload' to force Netscape to load the
406 file rather than displaying a cached copy.")
407
408 (defvar browse-url-usr1-signal
409 (if (and (boundp 'emacs-major-version)
410 (or (> emacs-major-version 19) (>= emacs-minor-version 29)))
411 'SIGUSR1 ; Why did I think this was in lower case before?
412 30) ; Check /usr/include/signal.h.
413 "The argument to `signal-process' for sending SIGUSR1 to XMosaic.
414 Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer
415 which is 30 on SunOS and 16 on HP-UX and Solaris.")
416
417 (defvar browse-url-CCI-port 3003
418 "Port to access XMosaic via CCI.
419 This can be any number between 1024 and 65535 but must correspond to
420 the value set in the browser.")
421
422 (defvar browse-url-CCI-host "localhost"
423 "*Host to access XMosaic via CCI.
424 This should be the host name of the machine running XMosaic with CCI
425 enabled. The port number should be set in `browse-url-CCI-port'.")
426
427 (defvar browse-url-temp-file-name nil)
428 (make-variable-buffer-local 'browse-url-temp-file-name)
429
430 (defvar browse-url-temp-file-list '())
431
432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
433 ;; URL input
434
435 ;; thingatpt.el doesn't work for complex regexps
436
437 (defun browse-url-url-at-point ()
438 "Return the URL around or before point.
439 Search backwards for the start of a URL ending at or after
440 point. If no URL found, return the empty string. The
441 access scheme, `http://' will be prepended if absent."
442 (cond ((browse-url-looking-at browse-url-regexp)
443 (buffer-substring (match-beginning 0) (match-end 0)))
444 ;; Access scheme omitted?
445 ((browse-url-looking-at browse-url-short-regexp)
446 (concat "http://"
447 (buffer-substring (match-beginning 0) (match-end 0))))
448 (t ""))) ; No match
449
450 (defun browse-url-looking-at (regexp)
451 "Return non-nil if point is in or just after a match for REGEXP.
452 Set the match data from the earliest such match in the current line
453 ending at or after point."
454 (save-excursion
455 (let ((old-point (point))
456 (eol (progn (end-of-line) (point)))
457 (hit nil))
458 (beginning-of-line)
459 (or (and (looking-at regexp)
460 (>= (match-end 0) old-point))
461 (progn
462 (while (and (re-search-forward regexp eol t)
463 (<= (match-beginning 0) old-point)
464 (not (setq hit (>= (match-end 0) old-point)))))
465 hit)))))
466
467 ;; Having this as a separate function called by the browser-specific
468 ;; functions allows them to be stand-alone commands, making it easier
469 ;; to switch between browsers.
470
471 (defun browse-url-interactive-arg (prompt)
472 "Read a URL from the minibuffer, prompting with PROMPT.
473 Default to the URL at or before point. If invoke with a mouse button,
474 set point to the position clicked first. Return a list for use in
475 `interactive' containing the URL and browse-url-new-window-p or its
476 negation if a prefix argument was given."
477 (let ((event (elt (this-command-keys) 0)))
478 (and (listp event) (mouse-set-point event)))
479 (list (read-string prompt (browse-url-url-at-point))
480 (not (eq (null browse-url-new-window-p)
481 (null current-prefix-arg)))))
482
483 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
484 ;; Browse current buffer
485
486 (defun browse-url-of-file (&optional file)
487 "Ask a WWW browser to display FILE.
488 Display the current buffer's file if FILE is nil or if called
489 interactively. Turn the filename into a URL with function
490 browse-url-file-url. Pass the URL to a browser using variable
491 `browse-url-browser-function' then run `browse-url-of-file-hook'."
492 (interactive)
493 (or file
494 (setq file (buffer-file-name))
495 (error "Current buffer has no file"))
496 (let ((buf (get-file-buffer file)))
497 (if buf
498 (save-excursion
499 (set-buffer buf)
500 (cond ((not (buffer-modified-p)))
501 (browse-url-save-file (save-buffer))
502 (t (message "%s modified since last save" file))))))
503 (funcall browse-url-browser-function (browse-url-file-url file))
504 (run-hooks 'browse-url-of-file-hook))
505
506 (defun browse-url-file-url (file)
507 "Return the URL corresponding to FILE.
508 Use variable `browse-url-filename-alist' to map filenames to URLs.
509 Convert EFS file names of the form /USER@HOST:PATH to ftp://HOST/PATH."
510 ;; URL-encode special chars, do % first
511 (let ((s 0))
512 (while (setq s (string-match "%" file s))
513 (setq file (replace-match "%25" t t file)
514 s (1+ s))))
515 (while (string-match "[*\"()',=;? ]" file)
516 (setq enc (format "%%%x" (aref file (match-beginning 0)))
517 file (replace-match enc t t file)))
518 (let ((maps browse-url-filename-alist))
519 (while maps
520 (let* ((map (car maps))
521 (from-re (car map))
522 (to-string (cdr map)))
523 (setq maps (cdr maps))
524 (and (string-match from-re file)
525 (setq file (replace-match to-string t t file))))))
526 ;; Check for EFS path
527 (and (string-match "^/\\([^:@]+@\\)?\\([^:]+\\):/*" file)
528 (setq file (concat "ftp://"
529 (substring file (match-beginning 2) (match-end 2))
530 "/" (substring file (match-end 0)))))
531 file)
532
533 (defun browse-url-of-buffer (&optional buffer)
534 "Ask a WWW browser to display BUFFER.
535 Display the current buffer if BUFFER is nil."
536 (interactive)
537 (save-excursion
538 (and buffer (set-buffer buffer))
539 (let ((file-name
540 (or buffer-file-name
541 (and (boundp 'dired-directory) dired-directory))))
542 (or file-name
543 (progn
544 (or browse-url-temp-file-name
545 (setq browse-url-temp-file-name
546 (make-temp-name
547 (expand-file-name (buffer-name)
548 (or (getenv "TMPDIR") "/tmp")))
549 browse-url-temp-file-list
550 (cons browse-url-temp-file-name
551 browse-url-temp-file-list)))
552 (setq file-name browse-url-temp-file-name)
553 (write-region (point-min) (point-max) file-name nil 'no-message)))
554 (browse-url-of-file file-name))))
555
556 (defun browse-url-delete-temp-file (&optional temp-file-name)
557 ;; Delete browse-url-temp-file-name from the file system and from
558 ;; browse-url-temp-file-list. If optional arg TEMP-FILE-NAME is
559 ;; non-nil, delete it instead, but only from the file system --
560 ;; browse-url-temp-file-list is not affected.
561 (let ((file-name (or temp-file-name browse-url-temp-file-name)))
562 (if (and file-name (file-exists-p file-name))
563 (progn
564 (delete-file file-name)
565 (if (null temp-file-name)
566 (setq browse-url-temp-file-list
567 (delete browse-url-temp-file-name
568 browse-url-temp-file-list)))))))
569
570 (defun browse-url-delete-temp-file-list ()
571 ;; Delete all elements of browse-url-temp-file-list.
572 (while browse-url-temp-file-list
573 (browse-url-delete-temp-file (car browse-url-temp-file-list))
574 (setq browse-url-temp-file-list
575 (cdr browse-url-temp-file-list))))
576
577 (add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
578 (add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list)
579
580 (defun browse-url-of-dired-file ()
581 "In Dired, ask a WWW browser to display the file named on this line."
582 (interactive)
583 (browse-url-of-file (dired-get-filename)))
584
585 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
586 ;; Browser-independant commands
587
588 ;; A generic command to call the current b-u-browser-function
589
590 (defun browse-url (&rest args)
591 "Ask a WWW browser to load URL.
592 Prompts for a URL, defaulting to the URL at or before point. Variable
593 `browse-url-browser-function' says which browser to use."
594 (interactive (browse-url-interactive-arg "URL: "))
595 (apply browse-url-browser-function args))
596
597 (defun browse-url-at-point ()
598 "Ask a WWW browser to load the URL at or before point.
599 Doesn't let you edit the URL like browse-url. Variable
600 `browse-url-browser-function' says which browser to use."
601 (interactive)
602 (funcall browse-url-browser-function (browse-url-url-at-point)))
603
604 ;; Define these if not already defined (XEmacs compatibility)
605
606 (eval-and-compile
607 (or (fboundp 'event-buffer)
608 (defun event-buffer (event)
609 (window-buffer (posn-window (event-start event))))))
610
611 (eval-and-compile
612 (or (fboundp 'event-point)
613 (defun event-point (event)
614 (posn-point (event-start event)))))
615
616 (defun browse-url-at-mouse (event)
617 "Ask a WWW browser to load a URL clicked with the mouse.
618 The URL is the one around or before the position of the mouse click
619 but point is not changed. Doesn't let you edit the URL like
620 browse-url. Variable `browse-url-browser-function' says which browser
621 to use."
622 (interactive "e")
623 (save-excursion
624 (set-buffer (event-buffer event))
625 (goto-char (event-point event))
626 (let ((url (browse-url-url-at-point)))
627 (if (string-equal url "")
628 (error "No URL found"))
629 (funcall browse-url-browser-function url))))
630
631 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
632 ;; Browser-specific commands
633
634 ;; --- Netscape ---
635
636 ;; Put the correct DISPLAY value in the environment for Netscape
637 ;; launched from multi-display Emacs.
638
639 (defun browse-url-process-environment ()
640 (let* ((device (and (fboundp 'selected-device)
641 (fboundp 'device-connection)
642 (selected-device)))
643 (display (and device (fboundp 'device-type)
644 (eq (device-type device) 'x)
645 (not (equal (device-connection device)
646 (getenv "DISPLAY"))))))
647 (if display
648 ;; Attempt to run on the correct display
649 (cons (concat "DISPLAY=" (device-connection device))
650 process-environment)
651 process-environment)))
652
653
654 ;;;###autoload
655 (defun browse-url-netscape (url &optional new-window)
656 "Ask the Netscape WWW browser to load URL.
657
658 Default to the URL around or before point. The strings in variable
659 `browse-url-netscape-arguments' are also passed to Netscape.
660
661 When called interactively, if variable `browse-url-new-window-p' is
662 non-nil, load the document in a new Netscape window, otherwise use a
663 random existing one. A non-nil interactive prefix argument reverses
664 the effect of browse-url-new-window-p.
665
666 When called non-interactively, optional second argument NEW-WINDOW is
667 used instead of browse-url-new-window-p."
668 (interactive (browse-url-interactive-arg "Netscape URL: "))
669 (let* ((process-environment (browse-url-process-environment))
670 (process (apply 'start-process
671 (concat "netscape " url) nil
672 browse-url-netscape-command
673 (append browse-url-netscape-arguments
674 (if new-window '("-noraise"))
675 (list "-remote"
676 (concat "openURL(" url
677 (if new-window ",new-window")
678 ")"))))))
679 (set-process-sentinel process
680 (list 'lambda '(process change)
681 (list 'browse-url-netscape-sentinel 'process url)))))
682
683 (defun browse-url-netscape-sentinel (process url)
684 "Handle a change to the process communicating with Netscape."
685 (or (eq (process-exit-status process) 0)
686 (let* ((process-environment (browse-url-process-environment)))
687 ;; Netscape not running - start it
688 (message "Starting Netscape...")
689 (apply 'start-process (concat "netscape" url) nil
690 browse-url-netscape-command
691 (append browse-url-netscape-arguments (list url))))))
692
693 (defun browse-url-netscape-reload ()
694 "Ask Netscape to reload its current document."
695 (interactive)
696 (browse-url-netscape-send "reload"))
697
698 (defun browse-url-netscape-send (command)
699 "Send a remote control command to Netscape."
700 (let* ((process-environment (browse-url-process-environment)))
701 (apply 'start-process "netscape" nil
702 browse-url-netscape-command
703 (append browse-url-netscape-arguments
704 (list "-remote" command)))))
705
706 ;; --- Mosaic ---
707
708 ;;;###autoload
709 (defun browse-url-mosaic (url &optional new-window)
710 ;; new-window ignored
711 "Ask the XMosaic WWW browser to load URL.
712 Default to the URL around or before point."
713 (interactive (browse-url-interactive-arg "Mosaic URL: "))
714 (let ((pidfile (expand-file-name "~/.mosaicpid"))
715 pid pidbuf)
716 (if (file-readable-p pidfile)
717 (save-excursion
718 (find-file pidfile)
719 (goto-char (point-min))
720 (setq pid (read (current-buffer)))
721 (kill-buffer nil)))
722 (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
723 (save-excursion
724 (find-file (format "/tmp/Mosaic.%d" pid))
725 (erase-buffer)
726 (insert "goto\n" url "\n")
727 (save-buffer)
728 (kill-buffer nil)
729 ;; Send signal SIGUSR to Mosaic
730 (message "Signalling Mosaic...")
731 (signal-process pid browse-url-usr1-signal)
732 ;; Or you could try:
733 ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
734 (message "Signalling Mosaic...done")
735 )
736 ;; Mosaic not running - start it
737 (message "Starting Mosaic...")
738 (apply 'start-process "xmosaic" nil "xmosaic"
739 (append browse-url-mosaic-arguments (list url)))
740 (message "Starting Mosaic...done"))))
741
742 ;; --- Grail ---
743
744 (defvar browse-url-grail
745 (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py")
746 "*Location of Grail remote control client script `rcgrail.py'.
747 Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
748
749 ;;;###autoload
750 (defun browse-url-grail (url)
751 "Ask the Grail WWW browser to load URL.
752 Default to the URL around or before point. Runs the program in the
753 variable `browse-url-grail'."
754 (interactive (browse-url-interactive-arg "Grail URL: "))
755 (message "Sending URL to Grail...")
756 (save-excursion
757 (set-buffer (get-buffer-create " *Shell Command Output*"))
758 (erase-buffer)
759 ;; don't worry about this failing.
760 (call-process browse-url-grail nil 0 nil url)
761 (message "Sending URL to Grail... done")))
762
763 ;; --- Mosaic using CCI ---
764
765 (defun browse-url-cci (url &optional new-window)
766 "Ask the XMosaic WWW browser to load URL.
767 Default to the URL around or before point.
768
769 This function only works for XMosaic version 2.5 or later. You must
770 select `CCI' from XMosaic's File menu, set the CCI Port Address to the
771 value of variable `browse-url-CCI-port', and enable `Accept requests'.
772
773 When called interactively, if variable `browse-url-new-window-p' is
774 non-nil, load the document in a new browser window, otherwise use a
775 random existing one. A non-nil interactive prefix argument reverses
776 the effect of browse-url-new-window-p.
777
778 When called non-interactively, optional second argument NEW-WINDOW is
779 used instead of browse-url-new-window-p."
780 (interactive (browse-url-interactive-arg "Mosaic URL: "))
781 (open-network-stream "browse-url" " *browse-url*"
782 browse-url-CCI-host browse-url-CCI-port)
783 ;; Todo: start browser if fails
784 (process-send-string "browse-url"
785 (concat "get url (" url ") output "
786 (if new-window "new" "current") "\r\n"))
787 (process-send-string "browse-url" "disconnect\r\n")
788 (delete-process "browse-url"))
789
790 ;; --- IXI Mosaic ---
791
792 ;;;###autoload
793 (defun browse-url-iximosaic (url &optional new-window)
794 ;; new-window ignored
795 "Ask the IXIMosaic WWW browser to load URL.
796 Default to the URL around or before point."
797 (interactive (browse-url-interactive-arg "IXI Mosaic URL: "))
798 (start-process "tellw3b" nil "tellw3b"
799 "-service WWW_BROWSER ixi_showurl " url))
800
801 ;; --- W3 ---
802
803 ;;;###autoload
804 (defun browse-url-w3 (url &optional new-window)
805 ;; new-window ignored
806 "Ask the w3 WWW browser to load URL.
807 Default to the URL around or before point."
808 (interactive (browse-url-interactive-arg "W3 URL: "))
809 (w3-fetch url))
810
811 ;; --- Lynx in an xterm ---
812
813 ;;;###autoload
814 (defun browse-url-lynx-xterm (url &optional new-window)
815 ;; new-window ignored
816 "Ask the Lynx WWW browser to load URL.
817 Default to the URL around or before point. A new Lynx process is run
818 in an Xterm window."
819 (interactive (browse-url-interactive-arg "Lynx URL: "))
820 (start-process (concat "lynx" url) nil "xterm" "-e" "lynx" url))
821
822 (eval-when-compile (require 'term))
823
824 ;; --- Lynx in an Emacs "term" window ---
825
826 ;;;###autoload
827 (defun browse-url-lynx-emacs (url &optional new-window)
828 ;; new-window ignored
829 "Ask the Lynx WWW browser to load URL.
830 Default to the URL around or before point. Run a new Lynx process in
831 an Emacs buffer."
832 (interactive (browse-url-interactive-arg "Lynx URL: "))
833 (let ((system-uses-terminfo t)) ; Lynx uses terminfo
834 (if (fboundp 'make-term)
835 (let ((term-term-name "vt100"))
836 (set-buffer (make-term "browse-url" "lynx" nil url))
837 (term-mode)
838 (term-char-mode)
839 (switch-to-buffer "*browse-url*"))
840 (terminal-emulator "*browse-url*" "lynx" (list url)))))
841
842 (provide 'browse-url)
843
844 ;;; browse-url.el ends here