browse-url.el 27.9 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1
;;; browse-url.el --- ask a WWW browser to load a URL
Erik Naggum's avatar
Erik Naggum committed
2

Richard M. Stallman's avatar
Richard M. Stallman committed
3
;; Copyright 1995, 1996 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5 6 7 8 9 10 11 12 13

;; Author: Denis Howe <dbh@doc.ic.ac.uk>
;; Maintainer: Denis Howe <dbh@doc.ic.ac.uk>
;; Created: 03 Apr 1995
;; Keywords: hypertext
;; X-Home page: http://wombat.doc.ic.ac.uk/

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
Erik Naggum's avatar
Erik Naggum committed
14 15 16
;; 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
17

Erik Naggum's avatar
Erik Naggum committed
18 19 20 21
;; 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
22 23 24

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Erik Naggum's avatar
Erik Naggum committed
25 26
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46

;;; Commentary:

;; The latest version of this package should be available from
;; <URL:http://wombat.doc.ic.ac.uk/emacs/browse-url.el>.

;; This package provides functions which read a URL (Uniform Resource
;; Locator) from the minibuffer, defaulting to the URL around point,
;; and ask a World-Wide Web browser to load it.  It can also load the
;; URL associated with the current buffer.  Different browsers use
;; different methods of remote control so there is one function for
;; each supported browser.  If the chosen browser is not running, it
;; is started.  Currently there is support for:

;; Function              Browser     Earliest version
;; browse-url-netscape   Netscape    1.1b1         
;; browse-url-mosaic     XMosaic     <= 2.4
;; browse-url-cci        XMosaic     2.5
;; browse-url-w3         w3          0
;; browse-url-iximosaic  IXI Mosaic  ?
47 48
;; browse-url-lynx-*	 Lynx	     0
;; browse-url-grail      Grail       0.3b1
Richard M. Stallman's avatar
Richard M. Stallman committed
49 50

;; Note that versions of Netscape before 1.1b1 did not have remote
51 52
;; control.  <URL:http://www.netscape.com/newsref/std/x-remote.html>
;; and <URL:http://www.netscape.com/info/APIs/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
53 54

;; Netscape can cache Web pages so it may be necessary to tell it to
55
;; reload the current page if it has changed (e.g. if you have edited
Richard M. Stallman's avatar
Richard M. Stallman committed
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
;; it).  There is currently no perfect automatic solution to this.

;; Netscape allows you to specify the id of the window you want to
;; control but which window DO you want to control and how do you
;; discover its id?

;; If using XMosaic before version 2.5, check the definition of
;; browse-url-usr1-signal below.
;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html>

;; XMosaic version 2.5 introduced Common Client Interface allowing you
;; to control mosaic through Unix sockets.
;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/CCI/cci-spec.html>

;; William M. Perry's excellent "w3" WWW browser for
;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
;; has a function w3-follow-url-at-point, but that
;; doesn't let you edit the URL like browse-url.

;; I recommend Nelson Minar <nelson@santafe.edu>'s excellent
;; html-helper-mode.el for editing HTML and thank Nelson for
;; his many useful comments on this code.
;; <URL:http://www.santafe.edu/~nelson/hhm-beta/>

;; This package generalises function html-previewer-process in Marc
;; Andreessen <marca@ncsa.uiuc.edu>'s html-mode (LCD
;; modes/html-mode.el.Z) and provides better versions of the URL
;; functions in Michelangelo Grigni <mic@cs.ucsd.edu>'s ffap.el
;; (find-file-at-point) <URL:ftp://cs.ucsd.edu:/pub/mic/>.  The huge
;; hyperbole package also contains similar functions.

87 88 89 90 91 92 93 94
;; Grail is the freely available WWW browser implemented in Python, a
;; cool object-oriented freely available interpreted language.  Grail
;; 0.3b1 was the first version to have remote control as distributed.
;; For more information on Grail see
;; <URL:http://monty.cnri.reston.va.us/> and for more information on
;; Python see <url:http://www.python.org/>.  Grail support in
;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>.

Richard M. Stallman's avatar
Richard M. Stallman committed
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Help!

;; Can you write and test some code for the Macintrash and Windoze
;; Netscape remote control APIs?  (See the URL above).

;; Do any other browsers have remote control?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Usage

;; To display the URL at or before point:
;; M-x browse-url-at-point RET

;; To display a URL by shift-clicking on it, put this in your ~/.emacs
;; file:
111 112 113
;;      (global-set-key [S-mouse-2] 'browse-url-at-mouse)
;; (Note that using Shift-mouse-1 is not desirable because
;; that event has a standard meaning in Emacs.)
Richard M. Stallman's avatar
Richard M. Stallman committed
114 115 116 117 118 119 120 121 122 123

;; To display the current buffer in a web browser:
;; M-x browse-url-of-buffer RET

;; In Dired, to display the file named on the current line:
;; M-x browse-url-of-dired-file RET

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customisation (~/.emacs)

124 125
;; To see what variables are available for customization, type
;; `M-x set-variable browse-url TAB'.
Richard M. Stallman's avatar
Richard M. Stallman committed
126

127 128 129 130 131 132
;; Bind the browse-url commands to keys with the `C-c C-z' prefix
;; (as used by html-helper-mode):
;;	(global-set-key "\C-c\C-z." 'browse-url-at-point)
;;	(global-set-key "\C-c\C-zb" 'browse-url-of-buffer)
;;	(global-set-key "\C-c\C-zu" 'browse-url)
;;	(global-set-key "\C-c\C-zv" 'browse-url-of-file)
Richard M. Stallman's avatar
Richard M. Stallman committed
133
;;      (add-hook 'dired-mode-hook
134 135 136 137 138 139 140 141 142 143 144 145 146
;;		  (function (lambda ()
;;			      (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file))))

;; Browse URLs in mail messages by clicking mouse-2:
;;	(add-hook 'rmail-mode-hook (function (lambda () ; rmail-mode startup
;;	  (define-key rmail-mode-map [mouse-2] 'browse-url-at-mouse))))

;; Browse URLs in Usenet messages by clicking mouse-2:
;;	(eval-after-load "gnus"
;;	  '(define-key gnus-article-mode-map [mouse-2] 'browse-url-at-mouse))

;; Use the Emacs w3 browser when not running under X11:
;;	(or (eq window-system 'x)
Richard M. Stallman's avatar
Richard M. Stallman committed
147 148 149 150 151
;;          (setq browse-url-browser-function 'browse-url-w3))

;; To always save modified buffers before displaying the file in a browser:
;;      (setq browse-url-save-file t)

152 153
;; To get round the Netscape caching problem, you could EITHER have
;; write-file in html-helper-mode make Netscape reload the document:
Richard M. Stallman's avatar
Richard M. Stallman committed
154 155 156 157 158 159 160 161 162 163
;;
;;      (autoload 'browse-url-netscape-reload "browse-url"
;;        "Ask a WWW browser to redisplay the current file." t)
;;      (add-hook 'html-helper-mode-hook
;;                (function (lambda ()
;;                   (add-hook 'local-write-file-hooks
;;                             (function (lambda ()
;;                                (let ((local-write-file-hooks))
;;                                  (save-buffer))
;;                                (browse-url-netscape-reload)
Erik Naggum's avatar
Erik Naggum committed
164 165
;;                                t))                   ; => file written by hook
;;                             t))))                    ; append to l-w-f-hooks
Richard M. Stallman's avatar
Richard M. Stallman committed
166
;;
167
;; OR have browse-url-of-file ask Netscape to load and then reload the
Richard M. Stallman's avatar
Richard M. Stallman committed
168 169 170 171
;; file:
;;
;;      (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)

172
;; You may also want to customise browse-url-netscape-arguments, e.g.
Richard M. Stallman's avatar
Richard M. Stallman committed
173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
;;      (setq browse-url-netscape-arguments '("-install"))
;;
;; or similarly for the other browsers. 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Change Log:

;; 0.00 03 Apr 1995 Denis Howe <dbh@doc.ic.ac.uk>
;;      Created.

;; 0.01 04 Apr 1995
;;      All names start with "browse-url-".  Added provide.

;; 0.02 05 Apr 1995
;;      Save file at start of browse-url-of-file.
;;      Use start-process instead of start-process-shell-command.

;; 0.03 06 Apr 1995
191
;;	Add browse-url-netscape-reload, browse-url-netscape-send.
Richard M. Stallman's avatar
Richard M. Stallman committed
192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
;;      browse-url-of-file save file option.

;; 0.04 08 Apr 1995
;;      b-u-file-url separate function.  Change b-u-filename-alist
;;      default.

;; 0.05 09 Apr 1995
;;      Added b-u-of-file-hook.

;; 0.06 11 Apr 1995
;;      Improved .emacs suggestions and documentation.

;; 0.07 13 Apr 1995
;;      Added browse-url-interactive-arg optional prompt.

;; 0.08 18 Apr 1995
;;      Exclude final "." from browse-url-regexp.

;; 0.09 21 Apr 1995
;;      Added mouse-set-point to browse-url-interactive-arg.

;; 0.10 24 Apr 1995
;;      Added Mosaic signal sending variations.
;;      Thanks Brian K Servis <servis@ecn.purdue.edu>.
;;      Don't use xprop for Netscape.

;; 0.11 25 Apr 1995
;;      Fix reading of ~/.mosaicpid.  Thanks Dag.H.Wanvik@kvatro.no.

;; 0.12 27 Apr 1995
;;      Interactive prefix arg => URL *after* point.
;;      Thanks Michelangelo Grigni <mic@cs.ucsd.edu>.
;;      Added IXI Mosaic support.
;;      Thanks David Karr <dkarr@nmo.gtegsc.com>.

;; 0.13 28 Apr 1995
;;      Exclude final [,;] from browse-url-regexp.

;; 0.14 02 May 1995
;;      Provide browser argument variables.

;; 0.15 07 May 1995
;;      More Netscape options.  Thanks Peter Arius
;;      <arius@immd2.informatik.uni-erlangen.de>.

;; 0.16 17 May 1995
;;      Added browse-url-at-mouse.
;;      Thanks Wayne Mesard <wmesard@sgi.com>

;; 0.17 27 Jun 1995
;;      Renamed browse-url-at-point to browse-url-url-at-point.
;;      Added browse-url-at-point.
;;      Thanks Jonathan Cano <cano@patch.tandem.com>.

;; 0.18 16 Aug 1995
;;      Fixed call to browse-url-url-at-point in browse-url-at-point.
;;      Thanks Eric Ding <ericding@San-Jose.ate.slb.com>.

;; 0.19 24 Aug 1995
;;      Improved documentation.
;;      Thanks Kevin Rodgers <kevin.rodgers@ihs.com>.

;; 0.20 31 Aug 1995
;;      browse-url-of-buffer to handle file-less buffers.
;;      browse-url-of-dired-file browses current file in dired.
;;      Thanks Kevin Rodgers <kevin.rodgers@ihs.com>.

;; 0.21 09 Sep 1995
;;      XMosaic CCI functions.
;;      Thanks Marc Furrer <Marc.Furrer@di.epfl.ch>.

;; 0.22 13 Sep 1995
;;      Fixed new-window documentation and added to browse-url-cci.
;;      Thanks Dilip Sequeira <djs@dcs.ed.ac.uk>.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:

270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables

(eval-when-compile (require 'dired))

(defvar browse-url-path-regexp
  "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+"
  "A regular expression probably matching the host, path or e-mail
part of a URL.")

(defvar browse-url-short-regexp
  (concat "[-A-Za-z0-9.]+" browse-url-path-regexp)
  "A regular expression probably matching a URL without an access scheme.
Hostname matching is stricter in this case than for
``browse-url-regexp''.")

Richard M. Stallman's avatar
Richard M. Stallman committed
286
(defvar browse-url-regexp
287 288 289 290
  (concat
   "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
   browse-url-path-regexp)
  "A regular expression probably matching a complete URL.")
Richard M. Stallman's avatar
Richard M. Stallman committed
291

292 293

;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
294
(defvar browse-url-browser-function
295
  'browse-url-netscape
Richard M. Stallman's avatar
Richard M. Stallman committed
296
  "*Function to display the current buffer in a WWW browser.
297 298
Used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.")
Richard M. Stallman's avatar
Richard M. Stallman committed
299

300 301
(defvar browse-url-netscape-command "netscape"
  "*The name by which to invoke Netscape.")
302

Richard M. Stallman's avatar
Richard M. Stallman committed
303 304 305
(defvar browse-url-netscape-arguments nil
  "*A list of strings to pass to Netscape as arguments.")

306 307 308 309 310
(defvar browse-url-netscape-startup-arguments browse-url-netscape-arguments
  "*A list of strings to pass to Netscape when it starts up.
Defaults to the value of browse-url-netscape-arguments at the time
browse-url is loaded.")

Richard M. Stallman's avatar
Richard M. Stallman committed
311 312 313 314 315 316 317 318 319 320 321 322 323 324
(defvar browse-url-new-window-p nil
  "*If non-nil, always open a new browser window.
Passing an interactive argument to \\[browse-url-netscape] or
\\[browse-url-cci] reverses the effect of this variable.  Requires
Netscape version 1.1N or later or XMosaic version 2.5 or later.")

(defvar browse-url-mosaic-arguments nil
  "*A list of strings to pass to Mosaic as arguments.")

(defvar browse-url-filename-alist
  '(("^/+" . "file:/"))
  "An alist of (REGEXP . STRING) pairs.
Any substring of a filename matching one of the REGEXPs is replaced by
the corresponding STRING.  All pairs are applied in the order given.
325
The default value prepends `file:' to any path beginning with `/'.
Richard M. Stallman's avatar
Richard M. Stallman committed
326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341
Used by the `browse-url-of-file' command.")

(defvar browse-url-save-file nil
  "If non-nil, save the buffer before displaying its file.
Used by the `browse-url-of-file' command.")

(defvar browse-url-of-file-hook nil
  "A hook to be run with run-hook after `browse-url-of-file' has asked
a browser to load a file.

Set this to `browse-url-netscape-reload' to force Netscape to load the
file rather than displaying a cached copy.")

(defvar browse-url-usr1-signal
  (if (and (boundp 'emacs-major-version)
           (or (> emacs-major-version 19) (>= emacs-minor-version 29)))
342
      'SIGUSR1 ; Why did I think this was in lower case before?
Richard M. Stallman's avatar
Richard M. Stallman committed
343 344
    30)                                 ; Check /usr/include/signal.h.
  "The argument to `signal-process' for sending SIGUSR1 to XMosaic.
345
Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer
Richard M. Stallman's avatar
Richard M. Stallman committed
346 347 348 349 350 351 352
which is 30 on SunOS and 16 on HP-UX and Solaris.")

(defvar browse-url-CCI-port 3003
  "Port to access XMosaic via CCI.
This can be any number between 1024 and 65535 but must correspond to
the value set in the browser.")

353 354 355 356 357 358 359 360 361 362
(defvar browse-url-CCI-host "localhost"
  "*Host to access XMosaic via CCI.
This should be the host name of the machine running XMosaic with CCI
enabled.  The port number should be set in `browse-url-CCI-port'.")

(defvar browse-url-temp-file-name nil)
(make-variable-buffer-local 'browse-url-temp-file-name)

(defvar browse-url-temp-file-list '())

Richard M. Stallman's avatar
Richard M. Stallman committed
363 364 365
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input

366
;; thingatpt.el doesn't work for complex regexps
Richard M. Stallman's avatar
Richard M. Stallman committed
367 368 369

(defun browse-url-url-at-point ()
  "Return the URL around or before point.
370
Search backwards for the start of a URL ending at or after 
371 372 373 374 375 376
point.  If no URL found, return the empty string.
A file name is also acceptable, and `http://' will be prepended to it."
  (or (thing-at-point 'url)
      (let ((file (thing-at-point 'file)))
	(if file (concat "http://" file)))
      ""))
377 378 379 380 381 382 383 384 385 386 387

;; Having this as a separate function called by the browser-specific
;; functions allows them to be stand-alone commands, making it easier
;; to switch between browsers.

(defun browse-url-interactive-arg (prompt)
  "Read a URL from the minibuffer, prompting with PROMPT.
Default to the URL at or before point.  If invoke with a mouse button,
set point to the position clicked first.  Return a list for use in
`interactive' containing the URL and browse-url-new-window-p or its
negation if a prefix argument was given."
Richard M. Stallman's avatar
Richard M. Stallman committed
388 389
  (let ((event (elt (this-command-keys) 0)))
    (and (listp event) (mouse-set-point event)))
390 391 392
  (list (read-string prompt (browse-url-url-at-point))
	(not (eq (null browse-url-new-window-p)
		 (null current-prefix-arg)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
393 394 395 396

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browse current buffer

397
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
398 399 400
(defun browse-url-of-file (&optional file)
  "Ask a WWW browser to display FILE.
Display the current buffer's file if FILE is nil or if called
401 402 403
interactively.  Turn the filename into a URL with function
browse-url-file-url.  Pass the URL to a browser using variable
`browse-url-browser-function' then run `browse-url-of-file-hook'."
Richard M. Stallman's avatar
Richard M. Stallman committed
404 405
  (interactive)
        (or file
406 407
      (setq file (buffer-file-name))
      (error "Current buffer has no file"))
Richard M. Stallman's avatar
Richard M. Stallman committed
408 409 410 411 412 413 414 415 416 417 418 419
  (let ((buf (get-file-buffer file)))
    (if buf
        (save-excursion
          (set-buffer buf)
          (cond ((not (buffer-modified-p)))
                (browse-url-save-file (save-buffer))
                (t (message "%s modified since last save" file))))))
  (funcall browse-url-browser-function (browse-url-file-url file))
  (run-hooks 'browse-url-of-file-hook))

(defun browse-url-file-url (file)
  "Return the URL corresponding to FILE.
420 421 422 423 424 425 426 427 428 429
Use variable `browse-url-filename-alist' to map filenames to URLs.
Convert EFS file names of the form /USER@HOST:PATH to ftp://HOST/PATH."
  ;; URL-encode special chars, do % first
  (let ((s 0))
    (while (setq s (string-match "%" file s))
      (setq file (replace-match "%25" t t file)
	    s (1+ s))))
  (while (string-match "[*\"()',=;? ]" file)
    (let ((enc (format "%%%x" (aref file (match-beginning 0)))))
      (setq file (replace-match enc t t file))))
Richard M. Stallman's avatar
Richard M. Stallman committed
430 431 432 433 434 435
  (let ((maps browse-url-filename-alist))
    (while maps
      (let* ((map (car maps))
             (from-re (car map))
             (to-string (cdr map)))
        (setq maps (cdr maps))
436 437 438 439 440 441 442
	(and (string-match from-re file)
	     (setq file (replace-match to-string t t file))))))
  ;; Check for EFS path
  (and (string-match "^/\\([^:@]+@\\)?\\([^:]+\\):/*" file)
       (setq file (concat "ftp://"
			  (substring file (match-beginning 2) (match-end 2))
			  "/" (substring file (match-end 0)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
443 444
  file)

445
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
446 447 448 449 450
(defun browse-url-of-buffer (&optional buffer)
  "Ask a WWW browser to display BUFFER.
Display the current buffer if BUFFER is nil."
  (interactive)
  (save-excursion
451
    (and buffer (set-buffer buffer))
Richard M. Stallman's avatar
Richard M. Stallman committed
452 453 454
    (let ((file-name
           (or buffer-file-name
               (and (boundp 'dired-directory) dired-directory))))
455
      (or file-name
Richard M. Stallman's avatar
Richard M. Stallman committed
456
                (progn
457
	    (or browse-url-temp-file-name
Richard M. Stallman's avatar
Richard M. Stallman committed
458 459 460
                  (setq browse-url-temp-file-name
                        (make-temp-name
                         (expand-file-name (buffer-name)
461 462
					 (or (getenv "TMPDIR") "/tmp")))
		      browse-url-temp-file-list
Richard M. Stallman's avatar
Richard M. Stallman committed
463
                        (cons browse-url-temp-file-name
464 465 466 467
			    browse-url-temp-file-list)))
	    (setq file-name browse-url-temp-file-name)
	    (write-region (point-min) (point-max) file-name nil 'no-message)))
      (browse-url-of-file file-name))))
Richard M. Stallman's avatar
Richard M. Stallman committed
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492

(defun browse-url-delete-temp-file (&optional temp-file-name)
  ;; Delete browse-url-temp-file-name from the file system and from
  ;; browse-url-temp-file-list.  If optional arg TEMP-FILE-NAME is
  ;; non-nil, delete it instead, but only from the file system --
  ;; browse-url-temp-file-list is not affected.
  (let ((file-name (or temp-file-name browse-url-temp-file-name)))
    (if (and file-name (file-exists-p file-name))
        (progn
          (delete-file file-name)
          (if (null temp-file-name)
              (setq browse-url-temp-file-list
                    (delete browse-url-temp-file-name
                            browse-url-temp-file-list)))))))

(defun browse-url-delete-temp-file-list ()
  ;; Delete all elements of browse-url-temp-file-list.
  (while browse-url-temp-file-list
    (browse-url-delete-temp-file (car browse-url-temp-file-list))
    (setq browse-url-temp-file-list
          (cdr browse-url-temp-file-list))))

(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
(add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list)

493
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
494 495 496 497 498 499
(defun browse-url-of-dired-file ()
  "In Dired, ask a WWW browser to display the file named on this line."
  (interactive)
  (browse-url-of-file (dired-get-filename)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
500 501 502 503 504 505 506 507 508 509 510
;; Browser-independant commands

;; A generic command to call the current b-u-browser-function

(defun browse-url (&rest args)
  "Ask a WWW browser to load URL.
Prompts for a URL, defaulting to the URL at or before point.  Variable
`browse-url-browser-function' says which browser to use."
  (interactive (browse-url-interactive-arg "URL: "))
  (apply browse-url-browser-function args))

511
;;;###autoload
512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530
(defun browse-url-at-point ()
  "Ask a WWW browser to load the URL at or before point.
Doesn't let you edit the URL like browse-url.  Variable
`browse-url-browser-function' says which browser to use."
  (interactive)
  (funcall browse-url-browser-function (browse-url-url-at-point)))

;; Define these if not already defined (XEmacs compatibility)

(eval-and-compile
  (or (fboundp 'event-buffer)
      (defun event-buffer (event)
	(window-buffer (posn-window (event-start event))))))

(eval-and-compile
  (or (fboundp 'event-point)
      (defun event-point (event)
	(posn-point (event-start event)))))

531
;;;###autoload
532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568
(defun browse-url-at-mouse (event)
  "Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
but point is not changed.  Doesn't let you edit the URL like
browse-url.  Variable `browse-url-browser-function' says which browser
to use."
  (interactive "e")
  (save-excursion
    (set-buffer (event-buffer event))
    (goto-char (event-point event))
    (let ((url (browse-url-url-at-point)))
      (if (string-equal url "")
	  (error "No URL found"))
      (funcall browse-url-browser-function url))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browser-specific commands

;; --- Netscape ---

;; Put the correct DISPLAY value in the environment for Netscape
;; launched from multi-display Emacs.

(defun browse-url-process-environment ()
  (let* ((device (and (fboundp 'selected-device)
		      (fboundp 'device-connection)
                      (selected-device)))
         (display (and device (fboundp 'device-type)
                       (eq (device-type device) 'x)
                       (not (equal (device-connection device)
                                   (getenv "DISPLAY"))))))
    (if display
        ;; Attempt to run on the correct display
        (cons (concat "DISPLAY=" (device-connection device))
              process-environment)
      process-environment)))

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

570
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
571 572 573 574 575 576 577 578 579 580 581 582 583
(defun browse-url-netscape (url &optional new-window)
  "Ask the Netscape WWW browser to load URL.

Default to the URL around or before point.  The strings in variable
`browse-url-netscape-arguments' are also passed to Netscape.

When called interactively, if variable `browse-url-new-window-p' is
non-nil, load the document in a new Netscape window, otherwise use a
random existing one.  A non-nil interactive prefix argument reverses
the effect of browse-url-new-window-p.

When called non-interactively, optional second argument NEW-WINDOW is
used instead of browse-url-new-window-p."
584 585 586 587 588 589 590 591
  (interactive (browse-url-interactive-arg "Netscape URL: "))
  ;; URL encode any commas in the URL
  (while (string-match "," url)
    (setq url (replace-match "%2C" t t url)))
  (let* ((process-environment (browse-url-process-environment))
         (process (apply 'start-process
 			(concat "netscape " url) nil
 			browse-url-netscape-command
592 593 594 595 596
		(append browse-url-netscape-arguments
			(if new-window '("-noraise"))
			(list "-remote" 
			      (concat "openURL(" url 
				      (if new-window ",new-window")
597 598 599 600 601 602 603 604 605 606
 					      ")"))))))
    (set-process-sentinel process
       (list 'lambda '(process change)
	     (list 'browse-url-netscape-sentinel 'process url)))))

(defun browse-url-netscape-sentinel (process url)
  "Handle a change to the process communicating with Netscape."
  (or (eq (process-exit-status process) 0)
      (let* ((process-environment (browse-url-process-environment)))
	;; Netscape not running - start it
607
	    (message "Starting Netscape...")
608 609 610
	(apply 'start-process (concat "netscape" url) nil
	       browse-url-netscape-command
	       (append browse-url-netscape-startup-arguments (list url))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
611 612 613 614

(defun browse-url-netscape-reload ()
  "Ask Netscape to reload its current document."
  (interactive)
615
  (browse-url-netscape-send "reload"))
Richard M. Stallman's avatar
Richard M. Stallman committed
616

617
(defun browse-url-netscape-send (command)
Richard M. Stallman's avatar
Richard M. Stallman committed
618
  "Send a remote control command to Netscape."
619 620 621
  (let* ((process-environment (browse-url-process-environment)))
    (apply 'start-process "netscape" nil
           browse-url-netscape-command
Richard M. Stallman's avatar
Richard M. Stallman committed
622
         (append browse-url-netscape-arguments
623 624 625
                   (list "-remote" command)))))

;; --- Mosaic ---
Richard M. Stallman's avatar
Richard M. Stallman committed
626

627 628 629
;;;###autoload
(defun browse-url-mosaic (url &optional new-window)
  ;; new-window ignored
Richard M. Stallman's avatar
Richard M. Stallman committed
630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648
  "Ask the XMosaic WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "Mosaic URL: "))
  (let ((pidfile (expand-file-name "~/.mosaicpid"))
        pid pidbuf)
    (if (file-readable-p pidfile)
        (save-excursion
          (find-file pidfile)
          (goto-char (point-min))
          (setq pid (read (current-buffer)))
          (kill-buffer nil)))
    (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
        (save-excursion
          (find-file (format "/tmp/Mosaic.%d" pid))
          (erase-buffer)
          (insert "goto\n" url "\n")
          (save-buffer)
          (kill-buffer nil)
          ;; Send signal SIGUSR to Mosaic
649
	  (message "Signalling Mosaic...")
Richard M. Stallman's avatar
Richard M. Stallman committed
650 651 652
          (signal-process pid browse-url-usr1-signal)
          ;; Or you could try:
          ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
653
	  (message "Signalling Mosaic...done")
Richard M. Stallman's avatar
Richard M. Stallman committed
654 655 656
          )
      ;; Mosaic not running - start it
      (message "Starting Mosaic...")
657
      (apply 'start-process "xmosaic" nil "xmosaic"
658 659
             (append browse-url-mosaic-arguments (list url)))
      (message "Starting Mosaic...done"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
660

661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
;; --- Grail ---

;;;###autoload
(defvar browse-url-grail
  (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py")
  "*Location of Grail remote control client script `rcgrail.py'.
Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")

;;;###autoload
(defun browse-url-grail (url)
  "Ask the Grail WWW browser to load URL.
Default to the URL around or before point.  Runs the program in the
variable `browse-url-grail'."
  (interactive (browse-url-interactive-arg "Grail URL: "))
  (message "Sending URL to Grail...")
  (save-excursion
    (set-buffer (get-buffer-create " *Shell Command Output*"))
    (erase-buffer)
    ;; don't worry about this failing.
    (call-process browse-url-grail nil 0 nil url)
    (message "Sending URL to Grail... done")))

;; --- Mosaic using CCI ---

Richard M. Stallman's avatar
Richard M. Stallman committed
685 686 687 688 689 690 691 692 693 694 695 696 697 698 699
(defun browse-url-cci (url &optional new-window)
  "Ask the XMosaic WWW browser to load URL.
Default to the URL around or before point.

This function only works for XMosaic version 2.5 or later.  You must
select `CCI' from XMosaic's File menu, set the CCI Port Address to the
value of variable `browse-url-CCI-port', and enable `Accept requests'.

When called interactively, if variable `browse-url-new-window-p' is
non-nil, load the document in a new browser window, otherwise use a
random existing one.  A non-nil interactive prefix argument reverses
the effect of browse-url-new-window-p.

When called non-interactively, optional second argument NEW-WINDOW is
used instead of browse-url-new-window-p."
700
  (interactive (browse-url-interactive-arg "Mosaic URL: "))
Richard M. Stallman's avatar
Richard M. Stallman committed
701
  (open-network-stream "browse-url" " *browse-url*"
702
		       browse-url-CCI-host browse-url-CCI-port)
Richard M. Stallman's avatar
Richard M. Stallman committed
703 704 705 706 707 708 709
  ;; Todo: start browser if fails
  (process-send-string "browse-url"
                       (concat "get url (" url ") output "
                               (if new-window "new" "current") "\r\n"))
  (process-send-string "browse-url" "disconnect\r\n")
  (delete-process "browse-url"))

710 711 712 713 714
;; --- IXI Mosaic ---

;;;###autoload
(defun browse-url-iximosaic (url &optional new-window)
  ;; new-window ignored
Richard M. Stallman's avatar
Richard M. Stallman committed
715 716 717 718 719 720
  "Ask the IXIMosaic WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "IXI Mosaic URL: "))
  (start-process "tellw3b" nil "tellw3b"
                 "-service WWW_BROWSER ixi_showurl " url))

721 722 723 724 725
;; --- W3 ---

;;;###autoload
(defun browse-url-w3 (url &optional new-window)
  ;; new-window ignored
Richard M. Stallman's avatar
Richard M. Stallman committed
726 727 728 729 730
  "Ask the w3 WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "W3 URL: "))
  (w3-fetch url))

731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760
;; --- Lynx in an xterm ---

;;;###autoload
(defun browse-url-lynx-xterm (url &optional new-window)
  ;; new-window ignored
  "Ask the Lynx WWW browser to load URL.
Default to the URL around or before point.  A new Lynx process is run
in an Xterm window."
  (interactive (browse-url-interactive-arg "Lynx URL: "))
  (start-process (concat "lynx" url) nil "xterm" "-e" "lynx" url))

(eval-when-compile (require 'term))

;; --- Lynx in an Emacs "term" window ---

;;;###autoload
(defun browse-url-lynx-emacs (url &optional new-window)
  ;; new-window ignored
  "Ask the Lynx WWW browser to load URL.
Default to the URL around or before point.  Run a new Lynx process in
an Emacs buffer."
  (interactive (browse-url-interactive-arg "Lynx URL: "))
  (let ((system-uses-terminfo t))	; Lynx uses terminfo
    (if (fboundp 'make-term)
	(let ((term-term-name "vt100"))
	  (set-buffer (make-term "browse-url" "lynx" nil url))
	  (term-mode)
	  (term-char-mode)
	  (switch-to-buffer "*browse-url*"))
      (terminal-emulator "*browse-url*" "lynx" (list url)))))
761

Richard M. Stallman's avatar
Richard M. Stallman committed
762 763 764
(provide 'browse-url)

;;; browse-url.el ends here