cgit.sxemacs.org Git - gnus/blob - lisp/browse-url.el

   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.16 17 May 1995
   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-w3        w3          0
  46 ;; browse-url-iximosaic IXI Mosaic  ?
  47
  48 ;; Note that earlier versions of Netscape did not have remote control.
  49 ;; <URL:http://home.netscape.com/newsref/std/x-remote.html> and
  50 ;; <URL:http://home.netscape.com/info/APIs/>.
  51
  52 ;; If using Mosaic, check the definition of browse-url-usr1-signal
  53 ;; below.
  54 ;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html>
  55
  56 ;; William M. Perry's excellent "w3" WWW browser for
  57 ;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
  58 ;; has a function w3-follow-url-at-point, but that
  59 ;; doesn't let you edit the URL like browse-url.
  60
  61 ;; I recommend Nelson Minar <nelson@santafe.edu>'s excellent
  62 ;; html-helper-mode.el for editing HTML and thank Nelson for
  63 ;; his many useful comments on this code.
  64 ;; <URL:http://www.santafe.edu/~nelson/hhm-beta/>
  65
  66 ;; This package generalises function html-previewer-process in Marc
  67 ;; Andreessen <marca@ncsa.uiuc.edu>'s html-mode (LCD
  68 ;; modes/html-mode.el.Z) and provides better versions of the URL
  69 ;; functions in Michelangelo Grigni <mic@cs.ucsd.edu>'s ffap.el
  70 ;; (find-file-at-point) <URL:ftp://cs.ucsd.edu:/pub/mic/>.  The huge
  71 ;; hyperbole package also contains similar functions.
  72
  73 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74 ;; Help!
  75
  76 ;; Can you write and test some code for the Macintrash and Windoze
  77 ;; Netscape remote control APIs?  (See the URL above).
  78
  79 ;; Did earlier versions of Mosaic have remote control?
  80
  81 ;; Do any other browsers have remote control?
  82
  83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84 ;; Installation
  85
  86 ;; In your ~/.emacs, put:
  87 ;;
  88 ;;      (setq browse-url-browser-function
  89 ;;            (if (eq window-system 'x)
  90 ;;                'browse-url-netscape ; or browse-url-mosaic
  91 ;;              'browse-url-w3))
  92 ;;      (autoload browse-url-browser-function "browse-url.el"
  93 ;;        "Ask a WWW browser to show a URL." t)
  94 ;; Bind this to control-X w (normally undefined):
  95 ;;      (global-set-key "\C-xw" browse-url-browser-function)
  96 ;;      ;; Note: no quote       ^
  97
  98 ;; For viewing current buffer:
  99 ;;
 100 ;;      (autoload 'browse-url-of-file "browse-url.el"
 101 ;;        "Ask a WWW browser to display the current file." t)
 102 ;;      (setq browse-url-save-file t)   ; Always save
 103
 104 ;; To get round the Netscape caching problem, you could try either of
 105 ;; the following (but not both).  EITHER write-file in
 106 ;; html-helper-mode makes Netscape reload document:
 107 ;;
 108 ;;      (autoload 'browse-url-netscape-reload "browse-url.el"
 109 ;;        "Ask a WWW browser to redisplay the current file." t)
 110 ;;      (add-hook 'html-helper-mode-hook
 111 ;;                (function (lambda ()
 112 ;;                   (add-hook 'local-write-file-hooks
 113 ;;                             (function (lambda ()
 114 ;;                                (let ((local-write-file-hooks))
 115 ;;                                  (save-buffer))
 116 ;;                                (browse-url-netscape-reload)
 117 ;;                                t))                   ; => file written by hook
 118 ;;                             t))))                    ; append to l-w-f-hooks
 119 ;;
 120 ;; [Does this work for html-mode too?]
 121
 122 ;; OR browse-url-of-file ask Netscape to load and then reload the
 123 ;; file:
 124 ;;
 125 ;;      (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
 126
 127 ;; You may also want to customise browse-url-netscape-arguments, eg.
 128 ;;
 129 ;;      (setq browse-url-netscape-arguments '("-install"))
 130 ;;
 131 ;; or similarly for the other browsers.
 132
 133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 134 ;;; Change Log:
 135
 136 ;; 0.00 03 Apr 1995 Denis Howe <dbh@doc.ic.ac.uk>
 137 ;;      Created.
 138
 139 ;; 0.01 04 Apr 1995
 140 ;;      All names start with "browse-url-".  Added provide.
 141
 142 ;; 0.02 05 Apr 1995
 143 ;;      Save file at start of browse-url-of-file.
 144 ;;      Use start-process instead of start-process-shell-command.
 145
 146 ;; 0.03 06 Apr 1995
 147 ;;      Add browse-url-netscape-reload, browse-url-netscape-command.
 148 ;;      browse-url-of-file save file option.
 149
 150 ;; 0.04 08 Apr 1995
 151 ;;      b-u-file-url separate function.  Change b-u-filename-alist
 152 ;;      default.
 153
 154 ;; 0.05 09 Apr 1995
 155 ;;      Added b-u-of-file-hook.
 156
 157 ;; 0.06 11 Apr 1995
 158 ;;      Improved .emacs suggestions and documentation.
 159
 160 ;; 0.07 13 Apr 1995
 161 ;;      Added browse-url-interactive-arg optional prompt.
 162
 163 ;; 0.08 18 Apr 1995
 164 ;;      Exclude final "." from browse-url-regexp.
 165
 166 ;; 0.09 21 Apr 1995
 167 ;;      Added mouse-set-point to browse-url-interactive-arg.
 168
 169 ;; 0.10 24 Apr 1995
 170 ;;      Added Mosaic signal sending variations.
 171 ;;      Thanks Brian K Servis <servis@ecn.purdue.edu>.
 172 ;;      Don't use xprop for Netscape.
 173
 174 ;; 0.11 25 Apr 1995
 175 ;;      Fix reading of ~/.mosaicpid.  Thanks Dag.H.Wanvik@kvatro.no.
 176
 177 ;; 0.12 27 Apr 1995
 178 ;;      Interactive prefix arg => URL *after* point.
 179 ;;      Thanks Michelangelo Grigni <mic@cs.ucsd.edu>.
 180 ;;      Added IXI Mosaic support.
 181 ;;      Thanks David Karr <dkarr@nmo.gtegsc.com>.
 182
 183 ;; 0.13 28 Apr 1995
 184 ;;      Exclude final [,;] from browse-url-regexp.
 185
 186 ;; 0.14 02 May 1995
 187 ;;      Provide browser argument variables.
 188
 189 ;; 0.15 07 May 1995
 190 ;;      More Netscape options.  Thanks Peter Arius
 191 ;;      <arius@immd2.informatik.uni-erlangen.de>.
 192
 193 ;; 0.16 17 May 1995
 194 ;;      Added browse-url-at-mouse.
 195 ;;      Thanks Wayne Mesard <wmesard@sgi.com>
 196
 197 ;; 0.17 27 Jun 1995
 198 ;;      Renamed browse-url-at-point to browse-url-url-at-point.
 199 ;;      Added browse-url-at-point.
 200 ;;      Thanks Jonathan Cano <cano@patch.tandem.com>.
 201
 202 ;; Netscape can cache Web pages so it may be necessary to tell it to
 203 ;; reload the current page if it has changed (eg. if you have edited
 204 ;; it).  There is currently no perfect automatic solution to this.
 205
 206 ;; Netscape allows you to specify the id of the window you want to
 207 ;; control but which window DO you want to control and how do you
 208 ;; discover its id?
 209
 210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 211 ;;; Code:
 212
 213 (defvar browse-url-regexp
 214   "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+"
 215   "A regular expression probably matching a URL.")
 216
 217 (defvar browse-url-browser-function
 218   'browse-url-netscape
 219   "*Function to display the current buffer in a WWW browser.
 220 Used by function `browse-url-of-file'.")
 221
 222 (defvar browse-url-netscape-arguments nil
 223   "*A list of strings to pass to Netscape as arguments.")
 224
 225 (defvar browse-url-netscape-new-window-p nil
 226   "*If non-nil, Netscape always opens a new window.
 227 Passing an interactive argument to \\[browse-url-netscape] reverses
 228 the effect of this variable.  Requires Netscape version 1.1N or
 229 later.")
 230
 231 (defvar browse-url-mosaic-arguments nil
 232   "*A list of strings to pass to Mosaic as arguments.")
 233
 234 (defvar browse-url-filename-alist
 235   '(("^/+" . "file:/"))
 236   "An alist of (REGEXP . STRING) pairs.
 237 Any substring of a filename matching one of the REGEXPs is replaced by
 238 the corresponding STRING.  All pairs are applied in the order given.
 239 Used by function `browse-url-of-file'.")
 240
 241 (defvar browse-url-save-file nil
 242   "If non-nil, save the buffer before displaying its file.
 243 Used by function `browse-url-of-file'.")
 244
 245 (defvar browse-url-of-file-hook nil
 246   "A hook to be run with run-hook after `browse-url-of-file' has asked
 247 a browser to load a file.
 248
 249 Set this to `browse-url-netscape-reload' to force Netscape to load the
 250 file rather than displaying a cached copy.")
 251
 252 (defvar browse-url-usr1-signal
 253   (if (and (boundp 'emacs-major-version)
 254            (or (> emacs-major-version 19) (>= emacs-minor-version 29)))
 255       'sigusr1
 256     30)                                 ; Check /usr/include/signal.h.
 257   "The argument to `signal-process' for sending SIGUSR1 to XMosaic.
 258 Emacs 19.29 accepts 'sigusr1, earlier versions require an integer
 259 which is 30 on SunOS and 16 on HP-UX and Solaris.")
 260
 261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 262 ;; URL input
 263
 264 ;; thingatpt.el doesn't work for complex regexps.
 265
 266 (defun browse-url-url-at-point ()
 267   "Return the URL around or before point.
 268 Then search backwards for the start of a URL.  If no URL found, return
 269 the empty string."
 270   (if (or (looking-at browse-url-regexp)        ; Already at start
 271           (let ((eol (save-excursion (end-of-line) (point))))
 272             ;; Search forwards for the next URL or end of line in case
 273             ;; we're in the middle of one.
 274             (and (re-search-forward browse-url-regexp eol 'lim)
 275                  (goto-char (match-beginning 0)))
 276             ;; Now back to where we started or earlier.
 277             (re-search-backward browse-url-regexp nil t)))
 278       (buffer-substring (match-beginning 0) (match-end 0))
 279     ""))                                ; No match
 280
 281 ;; Todo: restrict to around or immediately before point.  Expand bare
 282 ;; hostname to URL.
 283
 284 (defun browse-url-interactive-arg (&optional prompt)
 285   "Read a URL from the minibuffer, optionally prompting with PROMPT.
 286 Default to the URL at or before point.  If bound to a mouse button,
 287 set point to the position clicked.  Return the result as a list for
 288 use in `interactive'."
 289   (let ((event (elt (this-command-keys) 0)))
 290     (and (listp event) (mouse-set-point event)))
 291   (list (read-string (or prompt "URL: ") (browse-url-url-at-point))))
 292
 293 (defun browse-url-at-point ()
 294   "Pass the URL at or before point to a WWW browser."
 295   (interactive)
 296   (funcall browse-url-browser-function (browse-url-at-point)))
 297
 298 (defun browse-url-at-mouse (event)
 299   "Ask a browser to load a URL clicked with the mouse.
 300 The URL is the one around or before the position of the mouse click
 301 but point is not changed.  The URL is loaded using variable
 302 `browse-url-browser-function'."
 303   (interactive "e")
 304   (save-excursion
 305     (let ((posn (event-start event)))
 306       (set-buffer (window-buffer (posn-window posn)))
 307       (goto-char (posn-point posn))
 308       (let ((url (browse-url-url-at-point)))
 309         (if (string-equal url "")
 310             (error "No URL found"))
 311         (funcall browse-url-browser-function url)))))
 312
 313 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 314 ;; Browse current buffer
 315
 316 (defun browse-url-of-file (&optional file)
 317   "Ask a WWW browser to display FILE.
 318 Display the current buffer's file if FILE is nil or if called
 319 interactively.  Turn the filename into a URL by performing
 320 replacements given in variable `browse-url-filename-alist'.  Pass the
 321 URL to a browser using variable `browse-url-browser-function' then run
 322 `browse-url-of-file-hook'."
 323   (interactive)
 324   (setq file (or file
 325                  (buffer-file-name)
 326                  (and (boundp 'dired-directory) dired-directory)))
 327   (let ((buf (get-file-buffer file)))
 328     (if buf (save-excursion
 329               (set-buffer buf)
 330               (cond
 331                ((not (buffer-modified-p)))
 332                (browse-url-save-file (save-buffer))
 333                (t (message "%s modified since last save" file))))))
 334   (funcall browse-url-browser-function
 335            (browse-url-file-url file))
 336   (run-hooks 'browse-url-of-file-hook))
 337
 338 (defun browse-url-file-url (file)
 339   "Return the URL corresponding to FILE.
 340 Uses variable `browse-url-filename-alist' to map filenames to URLs."
 341   (let ((maps browse-url-filename-alist))
 342     (while maps
 343       (let* ((map (car maps))
 344              (from-re (car map))
 345              (to-string (cdr map)))
 346         (setq maps (cdr maps))
 347         (if (string-match from-re file)
 348             (setq file (concat (substring file 0 (match-beginning 0))
 349                                to-string
 350                                (substring file (match-end 0))))))))
 351   file)
 352
 353 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 354 ;; Browser-specific functions
 355
 356 (defun browse-url-netscape (url &optional new-window)
 357   "Ask the Netscape WWW browser to load URL.
 358
 359 Default to the URL around or before point.  The strings in variable
 360 `browse-url-netscape-arguments' are also passed to Netscape.
 361
 362 If variable `browse-url-netscape-new-window-p' is non-nil, load the
 363 document in a new Netscape window, otherwise use a random existing
 364 one.  If optional argument NEW-WINDOW (prefix argument if interactive)
 365 is non-nil, the effect of browse-url-netscape-new-window-p is
 366 reversed."
 367   (interactive (append (browse-url-interactive-arg "Netscape URL: ")
 368                        (list (not (eq (null browse-url-netscape-new-window-p)
 369                                       (null current-prefix-arg))))))
 370   (or (zerop
 371        (apply 'call-process "netscape" nil nil nil
 372               (append browse-url-netscape-arguments
 373                       (if new-window '("-noraise"))
 374                       (list "-remote"
 375                             (concat "openURL(" url
 376                                     (if new-window ",new-window")
 377                                     ")")))))
 378       (progn                            ; Netscape not running - start it
 379         (message "Starting Netscape...")
 380         (apply 'start-process "netscape" nil "netscape"
 381                (append browse-url-netscape-arguments (list url))))))
 382
 383 (defun browse-url-netscape-reload ()
 384   "Ask Netscape to reload its current document."
 385   (interactive)
 386   (browse-url-netscape-command "reload"))
 387
 388 (defun browse-url-netscape-command (command)
 389   "Send a remote control command to Netscape."
 390   (apply 'start-process "netscape" nil "netscape"
 391          (append browse-url-netscape-arguments
 392                  (list "-remote" command))))
 393
 394 (defun browse-url-mosaic (url)
 395   "Ask the XMosaic WWW browser to load URL.
 396 Default to the URL around or before point."
 397   (interactive (browse-url-interactive-arg "Mosaic URL: "))
 398   (let ((pidfile (expand-file-name "~/.mosaicpid"))
 399         pid pidbuf)
 400     (if (file-readable-p pidfile)
 401         (save-excursion
 402           (find-file pidfile)
 403           (goto-char (point-min))
 404           (setq pid (read (current-buffer)))
 405           (kill-buffer nil)))
 406     (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
 407         (save-excursion
 408           (find-file (format "/tmp/Mosaic.%d" pid))
 409           (erase-buffer)
 410           (insert "goto\n" url "\n")
 411           (save-buffer)
 412           (kill-buffer nil)
 413           ;; Send signal SIGUSR to Mosaic
 414           (message "Signalling Mosaic...")
 415           (signal-process pid browse-url-usr1-signal)
 416           ;; Or you could try:
 417           ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
 418           )
 419       ;; Mosaic not running - start it
 420       (message "Starting Mosaic...")
 421       (apply 'start-process "xmosaic" nil "xmosaic"
 422              (append browse-url-mosaic-arguments (list url))))))
 423
 424 (defun browse-url-iximosaic (url)
 425   "Ask the IXIMosaic WWW browser to load URL.
 426 Default to the URL around or before point."
 427   (interactive (browse-url-interactive-arg "IXI Mosaic URL: "))
 428   (start-process "tellw3b" nil "tellw3b"
 429                  "-service WWW_BROWSER ixi_showurl " url))
 430
 431 (defun browse-url-w3 (url)
 432   "Ask the w3 WWW browser to load URL.
 433 Default to the URL around or before point."
 434   (interactive (browse-url-interactive-arg "W3 URL: "))
 435   (w3-fetch url))
 436
 437 (provide 'browse-url)
 438
 439 ;;; browse-url.el ends here