Mercurial > emacs
annotate lisp/browse-url.el @ 16053:649590c94d41
(create_process): Test defined (TIOCSCTTY)
and defined (HAVE_SETSID) instead of DONT_REOPEN_PTY.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 01 Sep 1996 21:56:24 +0000 |
parents | 0a03d2b02ba1 |
children | e25afe6ea4d6 |
rev | line source |
---|---|
13208 | 1 ;;; browse-url.el --- ask a WWW browser to load a URL |
14169 | 2 |
14734 | 3 ;; Copyright 1995, 1996 Free Software Foundation, Inc. |
13208 | 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 ;; Keywords: hypertext | |
9 ;; X-Home page: http://wombat.doc.ic.ac.uk/ | |
10 | |
11 ;; This file is part of GNU Emacs. | |
12 | |
13 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14169 | 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. | |
13208 | 17 |
14169 | 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. | |
13208 | 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 | |
14169 | 25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
26 ;; Boston, MA 02111-1307, USA. | |
13208 | 27 |
28 ;;; Commentary: | |
29 | |
30 ;; The latest version of this package should be available from | |
31 ;; <URL:http://wombat.doc.ic.ac.uk/emacs/browse-url.el>. | |
32 | |
33 ;; This package provides functions which read a URL (Uniform Resource | |
34 ;; Locator) from the minibuffer, defaulting to the URL around point, | |
35 ;; and ask a World-Wide Web browser to load it. It can also load the | |
36 ;; URL associated with the current buffer. Different browsers use | |
37 ;; different methods of remote control so there is one function for | |
38 ;; each supported browser. If the chosen browser is not running, it | |
39 ;; is started. Currently there is support for: | |
40 | |
41 ;; Function Browser Earliest version | |
42 ;; browse-url-netscape Netscape 1.1b1 | |
43 ;; browse-url-mosaic XMosaic <= 2.4 | |
44 ;; browse-url-cci XMosaic 2.5 | |
45 ;; browse-url-w3 w3 0 | |
46 ;; browse-url-iximosaic IXI Mosaic ? | |
47 | |
48 ;; Note that versions of Netscape before 1.1b1 did not have remote | |
49 ;; control. <URL:http://home.netscape.com/newsref/std/x-remote.html> | |
50 ;; and <URL:http://home.netscape.com/info/APIs/>. | |
51 | |
52 ;; Netscape can cache Web pages so it may be necessary to tell it to | |
53 ;; reload the current page if it has changed (eg. if you have edited | |
54 ;; it). There is currently no perfect automatic solution to this. | |
55 | |
56 ;; Netscape allows you to specify the id of the window you want to | |
57 ;; control but which window DO you want to control and how do you | |
58 ;; discover its id? | |
59 | |
60 ;; If using XMosaic before version 2.5, check the definition of | |
61 ;; browse-url-usr1-signal below. | |
62 ;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html> | |
63 | |
64 ;; XMosaic version 2.5 introduced Common Client Interface allowing you | |
65 ;; to control mosaic through Unix sockets. | |
66 ;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/CCI/cci-spec.html> | |
67 | |
68 ;; William M. Perry's excellent "w3" WWW browser for | |
69 ;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/> | |
70 ;; has a function w3-follow-url-at-point, but that | |
71 ;; doesn't let you edit the URL like browse-url. | |
72 | |
73 ;; I recommend Nelson Minar <nelson@santafe.edu>'s excellent | |
74 ;; html-helper-mode.el for editing HTML and thank Nelson for | |
75 ;; his many useful comments on this code. | |
76 ;; <URL:http://www.santafe.edu/~nelson/hhm-beta/> | |
77 | |
78 ;; This package generalises function html-previewer-process in Marc | |
79 ;; Andreessen <marca@ncsa.uiuc.edu>'s html-mode (LCD | |
80 ;; modes/html-mode.el.Z) and provides better versions of the URL | |
81 ;; functions in Michelangelo Grigni <mic@cs.ucsd.edu>'s ffap.el | |
82 ;; (find-file-at-point) <URL:ftp://cs.ucsd.edu:/pub/mic/>. The huge | |
83 ;; hyperbole package also contains similar functions. | |
84 | |
85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
86 ;; Help! | |
87 | |
88 ;; Can you write and test some code for the Macintrash and Windoze | |
89 ;; Netscape remote control APIs? (See the URL above). | |
90 | |
91 ;; Do any other browsers have remote control? | |
92 | |
93 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
94 ;; Usage | |
95 | |
96 ;; To display the URL at or before point: | |
97 ;; M-x browse-url-at-point RET | |
98 | |
99 ;; To display a URL by shift-clicking on it, put this in your ~/.emacs | |
100 ;; file: | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
101 ;; (global-set-key [S-mouse-2] 'browse-url-at-mouse) |
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
102 ;; (Note that using Shift-mouse-1 is not desirable because |
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
103 ;; that event has a standard meaning in Emacs.) |
13208 | 104 |
105 ;; To display the current buffer in a web browser: | |
106 ;; M-x browse-url-of-buffer RET | |
107 | |
108 ;; In Dired, to display the file named on the current line: | |
109 ;; M-x browse-url-of-dired-file RET | |
110 | |
111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
112 ;; Customisation (~/.emacs) | |
113 | |
114 ;; To see what variables are available for customization, type `M-x | |
115 ;; set-variable browse-url TAB'. | |
116 | |
117 ;; To bind the browse-url commands to keys with the `C-c u' prefix: | |
118 ;; (global-set-key "\C-cu." 'browse-url-at-point) | |
119 ;; (global-set-key "\C-cub" 'browse-url-of-buffer) | |
120 ;; (global-set-key "\C-cuf" 'browse-url-of-file) | |
121 ;; (add-hook 'dired-mode-hook | |
13224
e19603a14c3f
Repair line wrapping damage.
Erik Naggum <erik@naggum.no>
parents:
13208
diff
changeset
|
122 ;; (lambda () |
e19603a14c3f
Repair line wrapping damage.
Erik Naggum <erik@naggum.no>
parents:
13208
diff
changeset
|
123 ;; (local-set-key "\C-cuf" 'browse-url-of-dired-file)))) |
13208 | 124 ;; (if (boundp 'browse-url-browser-function) |
125 ;; (global-set-key "\C-cuu" browse-url-browser-function) | |
126 ;; (eval-after-load | |
127 ;; "browse-url" | |
128 ;; '(global-set-key "\C-cuu" browse-url-browser-function))) | |
129 | |
130 ;; To use the Emacs w3 browser when not running under X11: | |
131 ;; (if (not (eq window-system 'x)) | |
132 ;; (setq browse-url-browser-function 'browse-url-w3)) | |
133 | |
134 ;; To always save modified buffers before displaying the file in a browser: | |
135 ;; (setq browse-url-save-file t) | |
136 | |
137 ;; To get round the Netscape caching problem, you could try either of | |
138 ;; the following (but not both). EITHER write-file in | |
139 ;; html-helper-mode makes Netscape reload document: | |
140 ;; | |
141 ;; (autoload 'browse-url-netscape-reload "browse-url" | |
142 ;; "Ask a WWW browser to redisplay the current file." t) | |
143 ;; (add-hook 'html-helper-mode-hook | |
144 ;; (function (lambda () | |
145 ;; (add-hook 'local-write-file-hooks | |
146 ;; (function (lambda () | |
147 ;; (let ((local-write-file-hooks)) | |
148 ;; (save-buffer)) | |
149 ;; (browse-url-netscape-reload) | |
13224
e19603a14c3f
Repair line wrapping damage.
Erik Naggum <erik@naggum.no>
parents:
13208
diff
changeset
|
150 ;; t)) ; => file written by hook |
e19603a14c3f
Repair line wrapping damage.
Erik Naggum <erik@naggum.no>
parents:
13208
diff
changeset
|
151 ;; t)))) ; append to l-w-f-hooks |
13208 | 152 ;; |
153 ;; [Does this work for html-mode too?] | |
154 ;; | |
155 ;; OR browse-url-of-file ask Netscape to load and then reload the | |
156 ;; file: | |
157 ;; | |
158 ;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload) | |
159 | |
160 ;; You may also want to customise browse-url-netscape-arguments, eg. | |
161 ;; | |
162 ;; (setq browse-url-netscape-arguments '("-install")) | |
163 ;; | |
164 ;; or similarly for the other browsers. | |
165 | |
166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
167 ;;; Change Log: | |
168 | |
169 ;; 0.00 03 Apr 1995 Denis Howe <dbh@doc.ic.ac.uk> | |
170 ;; Created. | |
171 | |
172 ;; 0.01 04 Apr 1995 | |
173 ;; All names start with "browse-url-". Added provide. | |
174 | |
175 ;; 0.02 05 Apr 1995 | |
176 ;; Save file at start of browse-url-of-file. | |
177 ;; Use start-process instead of start-process-shell-command. | |
178 | |
179 ;; 0.03 06 Apr 1995 | |
180 ;; Add browse-url-netscape-reload, browse-url-netscape-command. | |
181 ;; browse-url-of-file save file option. | |
182 | |
183 ;; 0.04 08 Apr 1995 | |
184 ;; b-u-file-url separate function. Change b-u-filename-alist | |
185 ;; default. | |
186 | |
187 ;; 0.05 09 Apr 1995 | |
188 ;; Added b-u-of-file-hook. | |
189 | |
190 ;; 0.06 11 Apr 1995 | |
191 ;; Improved .emacs suggestions and documentation. | |
192 | |
193 ;; 0.07 13 Apr 1995 | |
194 ;; Added browse-url-interactive-arg optional prompt. | |
195 | |
196 ;; 0.08 18 Apr 1995 | |
197 ;; Exclude final "." from browse-url-regexp. | |
198 | |
199 ;; 0.09 21 Apr 1995 | |
200 ;; Added mouse-set-point to browse-url-interactive-arg. | |
201 | |
202 ;; 0.10 24 Apr 1995 | |
203 ;; Added Mosaic signal sending variations. | |
204 ;; Thanks Brian K Servis <servis@ecn.purdue.edu>. | |
205 ;; Don't use xprop for Netscape. | |
206 | |
207 ;; 0.11 25 Apr 1995 | |
208 ;; Fix reading of ~/.mosaicpid. Thanks Dag.H.Wanvik@kvatro.no. | |
209 | |
210 ;; 0.12 27 Apr 1995 | |
211 ;; Interactive prefix arg => URL *after* point. | |
212 ;; Thanks Michelangelo Grigni <mic@cs.ucsd.edu>. | |
213 ;; Added IXI Mosaic support. | |
214 ;; Thanks David Karr <dkarr@nmo.gtegsc.com>. | |
215 | |
216 ;; 0.13 28 Apr 1995 | |
217 ;; Exclude final [,;] from browse-url-regexp. | |
218 | |
219 ;; 0.14 02 May 1995 | |
220 ;; Provide browser argument variables. | |
221 | |
222 ;; 0.15 07 May 1995 | |
223 ;; More Netscape options. Thanks Peter Arius | |
224 ;; <arius@immd2.informatik.uni-erlangen.de>. | |
225 | |
226 ;; 0.16 17 May 1995 | |
227 ;; Added browse-url-at-mouse. | |
228 ;; Thanks Wayne Mesard <wmesard@sgi.com> | |
229 | |
230 ;; 0.17 27 Jun 1995 | |
231 ;; Renamed browse-url-at-point to browse-url-url-at-point. | |
232 ;; Added browse-url-at-point. | |
233 ;; Thanks Jonathan Cano <cano@patch.tandem.com>. | |
234 | |
235 ;; 0.18 16 Aug 1995 | |
236 ;; Fixed call to browse-url-url-at-point in browse-url-at-point. | |
237 ;; Thanks Eric Ding <ericding@San-Jose.ate.slb.com>. | |
238 | |
239 ;; 0.19 24 Aug 1995 | |
240 ;; Improved documentation. | |
241 ;; Thanks Kevin Rodgers <kevin.rodgers@ihs.com>. | |
242 | |
243 ;; 0.20 31 Aug 1995 | |
244 ;; browse-url-of-buffer to handle file-less buffers. | |
245 ;; browse-url-of-dired-file browses current file in dired. | |
246 ;; Thanks Kevin Rodgers <kevin.rodgers@ihs.com>. | |
247 | |
248 ;; 0.21 09 Sep 1995 | |
249 ;; XMosaic CCI functions. | |
250 ;; Thanks Marc Furrer <Marc.Furrer@di.epfl.ch>. | |
251 | |
252 ;; 0.22 13 Sep 1995 | |
253 ;; Fixed new-window documentation and added to browse-url-cci. | |
254 ;; Thanks Dilip Sequeira <djs@dcs.ed.ac.uk>. | |
255 | |
256 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
257 ;;; Code: | |
258 | |
259 (defvar browse-url-regexp | |
13224
e19603a14c3f
Repair line wrapping damage.
Erik Naggum <erik@naggum.no>
parents:
13208
diff
changeset
|
260 "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" |
13208 | 261 "A regular expression probably matching a URL.") |
262 | |
263 (defvar browse-url-browser-function | |
15780
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
264 'browse-url-choose-browser |
13208 | 265 "*Function to display the current buffer in a WWW browser. |
15780
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
266 This is used by the `browse-url-at-point', `browse-url-at-mouse', and |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
267 `browse-url-of-file' commands. |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
268 The function should take one argument, an URL.") |
13208 | 269 |
15656
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
270 (defvar browse-url-netscape-program "netscape" |
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
271 "*The name for invoking Netscape.") |
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
272 |
13208 | 273 (defvar browse-url-netscape-arguments nil |
274 "*A list of strings to pass to Netscape as arguments.") | |
275 | |
276 (defvar browse-url-new-window-p nil | |
277 "*If non-nil, always open a new browser window. | |
278 Passing an interactive argument to \\[browse-url-netscape] or | |
279 \\[browse-url-cci] reverses the effect of this variable. Requires | |
280 Netscape version 1.1N or later or XMosaic version 2.5 or later.") | |
281 | |
15656
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
282 (defvar browse-url-mosaic-program "xmosaic" |
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
283 "*The name for invoking Mosaic.") |
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
284 |
13208 | 285 (defvar browse-url-mosaic-arguments nil |
286 "*A list of strings to pass to Mosaic as arguments.") | |
287 | |
288 (defvar browse-url-filename-alist | |
289 '(("^/+" . "file:/")) | |
290 "An alist of (REGEXP . STRING) pairs. | |
291 Any substring of a filename matching one of the REGEXPs is replaced by | |
292 the corresponding STRING. All pairs are applied in the order given. | |
293 Used by the `browse-url-of-file' command.") | |
294 | |
295 (defvar browse-url-save-file nil | |
296 "If non-nil, save the buffer before displaying its file. | |
297 Used by the `browse-url-of-file' command.") | |
298 | |
299 (defvar browse-url-of-file-hook nil | |
300 "A hook to be run with run-hook after `browse-url-of-file' has asked | |
301 a browser to load a file. | |
302 | |
303 Set this to `browse-url-netscape-reload' to force Netscape to load the | |
304 file rather than displaying a cached copy.") | |
305 | |
306 (defvar browse-url-usr1-signal | |
307 (if (and (boundp 'emacs-major-version) | |
308 (or (> emacs-major-version 19) (>= emacs-minor-version 29))) | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
309 'SIGUSR1 |
13208 | 310 30) ; Check /usr/include/signal.h. |
311 "The argument to `signal-process' for sending SIGUSR1 to XMosaic. | |
13938
3e0b6a3707bd
(browse-url-usr1-signal): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
13933
diff
changeset
|
312 Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer |
13208 | 313 which is 30 on SunOS and 16 on HP-UX and Solaris.") |
314 | |
315 (defvar browse-url-CCI-port 3003 | |
316 "Port to access XMosaic via CCI. | |
317 This can be any number between 1024 and 65535 but must correspond to | |
318 the value set in the browser.") | |
319 | |
320 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
321 ;; URL input | |
322 | |
323 ;; thingatpt.el doesn't work for complex regexps. | |
324 | |
325 (defun browse-url-url-at-point () | |
326 "Return the URL around or before point. | |
327 Then search backwards for the start of a URL. If no URL found, return | |
328 the empty string." | |
329 (if (or (looking-at browse-url-regexp) ; Already at start | |
330 (let ((eol (save-excursion (end-of-line) (point)))) | |
331 ;; Search forwards for the next URL or end of line in case | |
332 ;; we're in the middle of one. | |
333 (and (re-search-forward browse-url-regexp eol 'lim) | |
334 (goto-char (match-beginning 0))) | |
335 ;; Now back to where we started or earlier. | |
336 (re-search-backward browse-url-regexp nil t))) | |
337 (buffer-substring (match-beginning 0) (match-end 0)) | |
338 "")) ; No match | |
339 | |
340 ;; Todo: restrict to around or immediately before point. Expand bare | |
341 ;; hostname to URL. | |
342 | |
343 (defun browse-url-interactive-arg (&optional prompt) | |
344 "Read a URL from the minibuffer, optionally prompting with PROMPT. | |
345 Default to the URL at or before point. If bound to a mouse button, | |
346 set point to the position clicked. Return the result as a list for | |
347 use in `interactive'." | |
348 (let ((event (elt (this-command-keys) 0))) | |
349 (and (listp event) (mouse-set-point event))) | |
350 (list (read-string (or prompt "URL: ") (browse-url-url-at-point)))) | |
351 | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
352 ;;;###autoload |
13208 | 353 (defun browse-url-at-point () |
354 "Ask a WWW browser to load the URL at or before point. | |
355 The URL is loaded according to the value of `browse-url-browser-function'." | |
356 (interactive) | |
357 (funcall browse-url-browser-function (browse-url-url-at-point))) | |
358 | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
359 ;;;###autoload |
13208 | 360 (defun browse-url-at-mouse (event) |
361 "Ask a WWW browser to load a URL clicked with the mouse. | |
362 The URL is the one around or before the position of the mouse click | |
363 but point is not changed. The URL is loaded according to the value of | |
364 `browse-url-browser-function'." | |
365 (interactive "e") | |
366 (save-excursion | |
367 (let ((posn (event-start event))) | |
368 (set-buffer (window-buffer (posn-window posn))) | |
369 (goto-char (posn-point posn)) | |
370 (let ((url (browse-url-url-at-point))) | |
371 (if (string-equal url "") | |
372 (error "No URL found")) | |
373 (funcall browse-url-browser-function url))))) | |
374 | |
375 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
376 ;; Browse current buffer | |
377 | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
378 ;;;###autoload |
13208 | 379 (defun browse-url-of-file (&optional file) |
380 "Ask a WWW browser to display FILE. | |
381 Display the current buffer's file if FILE is nil or if called | |
382 interactively. Turn the filename into a URL by performing | |
383 replacements given in variable `browse-url-filename-alist'. Pass the | |
384 URL to a browser using variable `browse-url-browser-function' then run | |
385 `browse-url-of-file-hook'." | |
386 (interactive) | |
387 (setq file | |
388 (or file | |
389 (buffer-file-name) | |
390 (error "Current buffer has no file"))) | |
391 (let ((buf (get-file-buffer file))) | |
392 (if buf | |
393 (save-excursion | |
394 (set-buffer buf) | |
395 (cond ((not (buffer-modified-p))) | |
396 (browse-url-save-file (save-buffer)) | |
397 (t (message "%s modified since last save" file)))))) | |
398 (funcall browse-url-browser-function (browse-url-file-url file)) | |
399 (run-hooks 'browse-url-of-file-hook)) | |
400 | |
401 (defun browse-url-file-url (file) | |
402 "Return the URL corresponding to FILE. | |
403 Uses variable `browse-url-filename-alist' to map filenames to URLs." | |
404 (let ((maps browse-url-filename-alist)) | |
405 (while maps | |
406 (let* ((map (car maps)) | |
407 (from-re (car map)) | |
408 (to-string (cdr map))) | |
409 (setq maps (cdr maps)) | |
410 (if (string-match from-re file) | |
411 (setq file (concat (substring file 0 (match-beginning 0)) | |
412 to-string | |
413 (substring file (match-end 0)))))))) | |
414 file) | |
415 | |
416 (defvar browse-url-temp-file-name nil) | |
417 (make-variable-buffer-local 'browse-url-temp-file-name) | |
418 | |
419 (defvar browse-url-temp-file-list '()) | |
420 | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
421 ;;;###autoload |
13208 | 422 (defun browse-url-of-buffer (&optional buffer) |
423 "Ask a WWW browser to display BUFFER. | |
424 Display the current buffer if BUFFER is nil." | |
425 (interactive) | |
426 (save-excursion | |
427 (set-buffer (or buffer (current-buffer))) | |
428 (let ((file-name | |
429 (or buffer-file-name | |
430 (and (boundp 'dired-directory) dired-directory)))) | |
431 (if (null file-name) | |
432 (progn | |
433 (if (null browse-url-temp-file-name) | |
434 (progn | |
435 (setq browse-url-temp-file-name | |
436 (make-temp-name | |
437 (expand-file-name (buffer-name) | |
438 (or (getenv "TMPDIR") "/tmp")))) | |
439 (setq browse-url-temp-file-list | |
440 (cons browse-url-temp-file-name | |
441 browse-url-temp-file-list)))) | |
442 (write-region (point-min) (point-max) browse-url-temp-file-name | |
443 nil 'no-message))) | |
444 (browse-url-of-file (or file-name browse-url-temp-file-name))))) | |
445 | |
446 (defun browse-url-delete-temp-file (&optional temp-file-name) | |
447 ;; Delete browse-url-temp-file-name from the file system and from | |
448 ;; browse-url-temp-file-list. If optional arg TEMP-FILE-NAME is | |
449 ;; non-nil, delete it instead, but only from the file system -- | |
450 ;; browse-url-temp-file-list is not affected. | |
451 (let ((file-name (or temp-file-name browse-url-temp-file-name))) | |
452 (if (and file-name (file-exists-p file-name)) | |
453 (progn | |
454 (delete-file file-name) | |
455 (if (null temp-file-name) | |
456 (setq browse-url-temp-file-list | |
457 (delete browse-url-temp-file-name | |
458 browse-url-temp-file-list))))))) | |
459 | |
460 (defun browse-url-delete-temp-file-list () | |
461 ;; Delete all elements of browse-url-temp-file-list. | |
462 (while browse-url-temp-file-list | |
463 (browse-url-delete-temp-file (car browse-url-temp-file-list)) | |
464 (setq browse-url-temp-file-list | |
465 (cdr browse-url-temp-file-list)))) | |
466 | |
467 (add-hook 'kill-buffer-hook 'browse-url-delete-temp-file) | |
468 (add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list) | |
469 | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
470 ;;;###autoload |
13208 | 471 (defun browse-url-of-dired-file () |
472 "In Dired, ask a WWW browser to display the file named on this line." | |
473 (interactive) | |
474 (browse-url-of-file (dired-get-filename))) | |
475 | |
476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
477 ;; Browser-specific functions | |
478 | |
479 (defun browse-url-netscape (url &optional new-window) | |
480 "Ask the Netscape WWW browser to load URL. | |
481 | |
482 Default to the URL around or before point. The strings in variable | |
483 `browse-url-netscape-arguments' are also passed to Netscape. | |
484 | |
485 When called interactively, if variable `browse-url-new-window-p' is | |
486 non-nil, load the document in a new Netscape window, otherwise use a | |
487 random existing one. A non-nil interactive prefix argument reverses | |
488 the effect of browse-url-new-window-p. | |
489 | |
490 When called non-interactively, optional second argument NEW-WINDOW is | |
491 used instead of browse-url-new-window-p." | |
492 | |
493 (interactive (append (browse-url-interactive-arg "Netscape URL: ") | |
494 (list (not (eq (null browse-url-new-window-p) | |
495 (null current-prefix-arg)))))) | |
14368
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
496 (let ((res |
15656
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
497 (apply 'call-process browse-url-netscape-program nil nil nil |
14368
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
498 (append browse-url-netscape-arguments |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
499 (if new-window '("-noraise")) |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
500 (list "-remote" |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
501 (concat "openURL(" url |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
502 (if new-window ",new-window") |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
503 ")")))) |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
504 )) |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
505 (if (stringp res) |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
506 (error "netscape got signal: %s" res) |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
507 (or (zerop res) |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
508 (progn ; Netscape not running - start it |
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
509 (message "Starting Netscape...") |
15656
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
510 (apply 'start-process "netscape" nil browse-url-netscape-program |
14368
861f51e090d4
(browse-url-netscape): Check for call-process returning a string.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
511 (append browse-url-netscape-arguments (list url)))))))) |
13208 | 512 |
513 (defun browse-url-netscape-reload () | |
514 "Ask Netscape to reload its current document." | |
515 (interactive) | |
516 (browse-url-netscape-command "reload")) | |
517 | |
518 (defun browse-url-netscape-command (command) | |
519 "Send a remote control command to Netscape." | |
520 (apply 'start-process "netscape" nil "netscape" | |
521 (append browse-url-netscape-arguments | |
522 (list "-remote" command)))) | |
523 | |
524 (defun browse-url-mosaic (url) | |
525 "Ask the XMosaic WWW browser to load URL. | |
526 Default to the URL around or before point." | |
527 (interactive (browse-url-interactive-arg "Mosaic URL: ")) | |
528 (let ((pidfile (expand-file-name "~/.mosaicpid")) | |
529 pid pidbuf) | |
530 (if (file-readable-p pidfile) | |
531 (save-excursion | |
532 (find-file pidfile) | |
533 (goto-char (point-min)) | |
534 (setq pid (read (current-buffer))) | |
535 (kill-buffer nil))) | |
536 (if (and pid (zerop (signal-process pid 0))) ; Mosaic running | |
537 (save-excursion | |
538 (find-file (format "/tmp/Mosaic.%d" pid)) | |
539 (erase-buffer) | |
540 (insert "goto\n" url "\n") | |
541 (save-buffer) | |
542 (kill-buffer nil) | |
543 ;; Send signal SIGUSR to Mosaic | |
544 (signal-process pid browse-url-usr1-signal) | |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
545 (message "Signal sent to Mosaic") |
13208 | 546 ;; Or you could try: |
547 ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) | |
548 ) | |
549 ;; Mosaic not running - start it | |
550 (message "Starting Mosaic...") | |
15656
e73cd7ff1d4a
(browse-url-netscape-program): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
14734
diff
changeset
|
551 (apply 'start-process "xmosaic" nil browse-url-mosaic-program |
13933
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
552 (append browse-url-mosaic-arguments (list url))) |
efd6ce432dc5
(browse-url-mosaic): Print "done" message
Richard M. Stallman <rms@gnu.org>
parents:
13224
diff
changeset
|
553 (message "Starting Mosaic...done")))) |
13208 | 554 |
555 (defun browse-url-cci (url &optional new-window) | |
556 "Ask the XMosaic WWW browser to load URL. | |
557 Default to the URL around or before point. | |
558 | |
559 This function only works for XMosaic version 2.5 or later. You must | |
560 select `CCI' from XMosaic's File menu, set the CCI Port Address to the | |
561 value of variable `browse-url-CCI-port', and enable `Accept requests'. | |
562 | |
563 When called interactively, if variable `browse-url-new-window-p' is | |
564 non-nil, load the document in a new browser window, otherwise use a | |
565 random existing one. A non-nil interactive prefix argument reverses | |
566 the effect of browse-url-new-window-p. | |
567 | |
568 When called non-interactively, optional second argument NEW-WINDOW is | |
569 used instead of browse-url-new-window-p." | |
570 (interactive (append (browse-url-interactive-arg "Mosaic URL: ") | |
571 (list (not (eq (null browse-url-new-window-p) | |
572 (null current-prefix-arg)))))) | |
573 (open-network-stream "browse-url" " *browse-url*" | |
574 "localhost" browse-url-CCI-port) | |
575 ;; Todo: start browser if fails | |
576 (process-send-string "browse-url" | |
577 (concat "get url (" url ") output " | |
578 (if new-window "new" "current") "\r\n")) | |
579 (process-send-string "browse-url" "disconnect\r\n") | |
580 (delete-process "browse-url")) | |
581 | |
582 (defun browse-url-iximosaic (url) | |
583 "Ask the IXIMosaic WWW browser to load URL. | |
584 Default to the URL around or before point." | |
585 (interactive (browse-url-interactive-arg "IXI Mosaic URL: ")) | |
586 (start-process "tellw3b" nil "tellw3b" | |
587 "-service WWW_BROWSER ixi_showurl " url)) | |
588 | |
589 (defun browse-url-w3 (url) | |
590 "Ask the w3 WWW browser to load URL. | |
591 Default to the URL around or before point." | |
592 (interactive (browse-url-interactive-arg "W3 URL: ")) | |
593 (w3-fetch url)) | |
594 | |
15780
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
595 (defun browse-url-choose-browser (argument) |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
596 "Decide which browser to use, then invoke it. |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
597 This is the default value of `browse-url-browser-function'." |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
598 (if (fboundp 'w3-fetch) |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
599 (setq browse-url-browser-function 'browse-url-w3) |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
600 (setq browse-url-browser-function 'browse-url-netscape)) |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
601 (funcall browse-url-browser-function argument)) |
0a03d2b02ba1
(browse-url-choose-browser): New function.
Richard M. Stallman <rms@gnu.org>
parents:
15656
diff
changeset
|
602 |
13208 | 603 (provide 'browse-url) |
604 | |
605 ;;; browse-url.el ends here |