diff options
| author | Richard M. Stallman | 1997-06-15 02:49:03 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-06-15 02:49:03 +0000 |
| commit | 5db5751426da4bbef4c33bd59e8055c5a3d72c30 (patch) | |
| tree | 9ee10a19862107cd6801e57b33ef4a726eae4e0f | |
| parent | fa1d3816e99d18df0c785b435b11642e3faa080d (diff) | |
| download | emacs-5db5751426da4bbef4c33bd59e8055c5a3d72c30.tar.gz emacs-5db5751426da4bbef4c33bd59e8055c5a3d72c30.zip | |
Update keywords to show up in finder.
(browse-url-gnudoit-args, browse-url-generic-program)
(browse-url-gnudoit-program, browse-url-generic-args): New variables.
(browse-url-w3-gnudoit): New procedure.
(browse-url-mmm): New location of `remote' file for MMM 0.4.
(browse-url-generic): New procedure.
(browse-url-netscape): Test for w32.
(browse-url-url-at-point): Assume mailto: if URL contains @.
Don't use thingatpt; find the URL here to do it correctly.
(browse-url-at-point, browse-url-of-file, browse-url-at-mouse):
Call browse-url.
(browse-url): Check for list browse-url-browser-function.
(browse-url-choose-browser): New procedure.
(browse-url-browser-function): Allow list value.
(browse-url-process-environment): Call browse-url-emacs-display.
(browse-url-emacs-display): New procedure.
(browse-url-netscape-display): New variable.
(browse-url-of-region): New procedure.
(browse-url-of-buffer): Check for narrowed buffer.
(browse-url-url-at-point): Rewrite to not use cl.el delete-if.
Fix multi-line URL matching.
(browse-url-markedup-regexp): New variable.
(browse-url-xterm-program): New variable.
(browse-url-xterm-args): New variable.
(browse-url-lynx-xterm): Use the above two vars.
(browse-url-url-at-point): Use buffer-substring-no-properties.
(browse-url-grail): Add missing optional arg.
(browse-url-mmm): New procedure.
(browse-url-netscape-startup-arguments): New variable.
| -rw-r--r-- | lisp/browse-url.el | 622 |
1 files changed, 383 insertions, 239 deletions
diff --git a/lisp/browse-url.el b/lisp/browse-url.el index e682df750a1..af24a1cafc3 100644 --- a/lisp/browse-url.el +++ b/lisp/browse-url.el | |||
| @@ -1,11 +1,11 @@ | |||
| 1 | ;;; browse-url.el --- ask a WWW browser to load a URL | 1 | ;;; browse-url.el --- Pass a URL to a WWW browser |
| 2 | 2 | ||
| 3 | ;; Copyright 1995, 1996 Free Software Foundation, Inc. | 3 | ;; Copyright 1995, 1996, 1997 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Denis Howe <dbh@doc.ic.ac.uk> | 5 | ;; Author: Denis Howe <dbh@doc.ic.ac.uk> |
| 6 | ;; Maintainer: Dave Love <d.love@dl.ac.uk> | 6 | ;; Maintainer: Dave Love <d.love@dl.ac.uk> |
| 7 | ;; Created: 03 Apr 1995 | 7 | ;; Created: 03 Apr 1995 |
| 8 | ;; Keywords: hypertext | 8 | ;; Keywords: hypertext, hypermedia, mouse |
| 9 | ;; X-Home page: http://wombat.doc.ic.ac.uk/ | 9 | ;; X-Home page: http://wombat.doc.ic.ac.uk/ |
| 10 | 10 | ||
| 11 | ;; This file is part of GNU Emacs. | 11 | ;; This file is part of GNU Emacs. |
| @@ -39,17 +39,19 @@ | |||
| 39 | ;; is started. Currently there is support for: | 39 | ;; is started. Currently there is support for: |
| 40 | 40 | ||
| 41 | ;; Function Browser Earliest version | 41 | ;; Function Browser Earliest version |
| 42 | ;; browse-url-netscape Netscape 1.1b1 | 42 | ;; browse-url-netscape Netscape 1.1b1 |
| 43 | ;; browse-url-mosaic XMosaic <= 2.4 | 43 | ;; browse-url-mosaic XMosaic <= 2.4 |
| 44 | ;; browse-url-cci XMosaic 2.5 | 44 | ;; browse-url-cci XMosaic 2.5 |
| 45 | ;; browse-url-w3 w3 0 | 45 | ;; browse-url-w3 w3 0 |
| 46 | ;; browse-url-w3-gnudoit w3 remotely | ||
| 46 | ;; browse-url-iximosaic IXI Mosaic ? | 47 | ;; browse-url-iximosaic IXI Mosaic ? |
| 47 | ;; browse-url-lynx-* Lynx 0 | 48 | ;; browse-url-lynx-* Lynx 0 |
| 48 | ;; browse-url-grail Grail 0.3b1 | 49 | ;; browse-url-grail Grail 0.3b1 |
| 50 | ;; browse-url-mmm MMM ? | ||
| 51 | ;; browse-url-generic arbitrary | ||
| 49 | 52 | ||
| 50 | ;; Note that versions of Netscape before 1.1b1 did not have remote | 53 | ;; Note that versions of Netscape before 1.1b1 did not have remote |
| 51 | ;; control. <URL:http://www.netscape.com/newsref/std/x-remote.html> | 54 | ;; control. <URL:http://www.netscape.com/newsref/std/x-remote.html>. |
| 52 | ;; and <URL:http://www.netscape.com/info/APIs/>. | ||
| 53 | 55 | ||
| 54 | ;; Netscape can cache Web pages so it may be necessary to tell it to | 56 | ;; 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 | 57 | ;; reload the current page if it has changed (e.g. if you have edited |
| @@ -71,11 +73,37 @@ | |||
| 71 | ;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/> | 73 | ;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/> |
| 72 | ;; has a function w3-follow-url-at-point, but that | 74 | ;; has a function w3-follow-url-at-point, but that |
| 73 | ;; doesn't let you edit the URL like browse-url. | 75 | ;; doesn't let you edit the URL like browse-url. |
| 76 | ;; The `gnuserv' package that can be used to control it in another | ||
| 77 | ;; Emacs process is available from | ||
| 78 | ;; <URL:http://hplbwww.hpl.hp.com/people/ange/gnuserv/>. | ||
| 79 | |||
| 80 | ;; Grail is the freely available WWW browser implemented in Python, a | ||
| 81 | ;; cool object-oriented freely available interpreted language. Grail | ||
| 82 | ;; 0.3b1 was the first version to have remote control as distributed. | ||
| 83 | ;; For more information on Grail see | ||
| 84 | ;; <URL:http://grail.cnri.reston.va.us/> and for more information on | ||
| 85 | ;; Python see <url:http://www.python.org/>. Grail support in | ||
| 86 | ;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>. | ||
| 87 | |||
| 88 | ;; MMM is the freely available WWW browser implemented in Caml Special | ||
| 89 | ;; Light, a cool impure functional programming language, by Francois | ||
| 90 | ;; Rouaix. See the MMM home page | ||
| 91 | ;; <URL:http://pauillac.inria.fr/%7Erouaix/mmm/>. | ||
| 92 | |||
| 93 | ;; Lynx is now distributed by the FSF. See also | ||
| 94 | ;; <URL:http://lynx.browser.org/>. | ||
| 95 | |||
| 96 | ;; Free graphical browsers that could be used by `browse-url-generic' | ||
| 97 | ;; include Chimera <URL:ftp://ftp.cs.unlv.edu/pub/chimera>, Arena | ||
| 98 | ;; <URL:ftp://ftp.yggdrasil.com/pub/dist/web/arena>, Amaya | ||
| 99 | ;; <URL:ftp://ftp.w3.org/pub/amaya>, mMosaic | ||
| 100 | ;; <URL:ftp://sig.enst.fr/pub/multicast/mMosaic/> (the latter with | ||
| 101 | ;; development support for Java applets). | ||
| 74 | 102 | ||
| 75 | ;; I recommend Nelson Minar <nelson@santafe.edu>'s excellent | 103 | ;; I recommend Nelson Minar <nelson@santafe.edu>'s excellent |
| 76 | ;; html-helper-mode.el for editing HTML and thank Nelson for | 104 | ;; html-helper-mode.el for editing HTML and thank Nelson for |
| 77 | ;; his many useful comments on this code. | 105 | ;; his many useful comments on this code. |
| 78 | ;; <URL:http://www.santafe.edu/~nelson/hhm-beta/> | 106 | ;; <URL:http://www.santafe.edu/%7Enelson/hhm-beta/> |
| 79 | 107 | ||
| 80 | ;; This package generalises function html-previewer-process in Marc | 108 | ;; This package generalises function html-previewer-process in Marc |
| 81 | ;; Andreessen <marca@ncsa.uiuc.edu>'s html-mode (LCD | 109 | ;; Andreessen <marca@ncsa.uiuc.edu>'s html-mode (LCD |
| @@ -84,14 +112,6 @@ | |||
| 84 | ;; (find-file-at-point) <URL:ftp://cs.ucsd.edu:/pub/mic/>. The huge | 112 | ;; (find-file-at-point) <URL:ftp://cs.ucsd.edu:/pub/mic/>. The huge |
| 85 | ;; hyperbole package also contains similar functions. | 113 | ;; hyperbole package also contains similar functions. |
| 86 | 114 | ||
| 87 | ;; Grail is the freely available WWW browser implemented in Python, a | ||
| 88 | ;; cool object-oriented freely available interpreted language. Grail | ||
| 89 | ;; 0.3b1 was the first version to have remote control as distributed. | ||
| 90 | ;; For more information on Grail see | ||
| 91 | ;; <URL:http://monty.cnri.reston.va.us/> and for more information on | ||
| 92 | ;; Python see <url:http://www.python.org/>. Grail support in | ||
| 93 | ;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>. | ||
| 94 | |||
| 95 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 115 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 96 | ;; Help! | 116 | ;; Help! |
| 97 | 117 | ||
| @@ -105,6 +125,9 @@ | |||
| 105 | 125 | ||
| 106 | ;; To display the URL at or before point: | 126 | ;; To display the URL at or before point: |
| 107 | ;; M-x browse-url-at-point RET | 127 | ;; M-x browse-url-at-point RET |
| 128 | ;; or, similarly but with the opportunity to edit the URL extracted from | ||
| 129 | ;; the buffer, use: | ||
| 130 | ;; M-x browse-url | ||
| 108 | 131 | ||
| 109 | ;; To display a URL by shift-clicking on it, put this in your ~/.emacs | 132 | ;; To display a URL by shift-clicking on it, put this in your ~/.emacs |
| 110 | ;; file: | 133 | ;; file: |
| @@ -115,6 +138,9 @@ | |||
| 115 | ;; To display the current buffer in a web browser: | 138 | ;; To display the current buffer in a web browser: |
| 116 | ;; M-x browse-url-of-buffer RET | 139 | ;; M-x browse-url-of-buffer RET |
| 117 | 140 | ||
| 141 | ;; To display the current region in a web browser: | ||
| 142 | ;; M-x browse-url-of-region RET | ||
| 143 | |||
| 118 | ;; In Dired, to display the file named on the current line: | 144 | ;; In Dired, to display the file named on the current line: |
| 119 | ;; M-x browse-url-of-dired-file RET | 145 | ;; M-x browse-url-of-dired-file RET |
| 120 | 146 | ||
| @@ -128,9 +154,10 @@ | |||
| 128 | ;; (as used by html-helper-mode): | 154 | ;; (as used by html-helper-mode): |
| 129 | ;; (global-set-key "\C-c\C-z." 'browse-url-at-point) | 155 | ;; (global-set-key "\C-c\C-z." 'browse-url-at-point) |
| 130 | ;; (global-set-key "\C-c\C-zb" 'browse-url-of-buffer) | 156 | ;; (global-set-key "\C-c\C-zb" 'browse-url-of-buffer) |
| 157 | ;; (global-set-key "\C-c\C-zr" 'browse-url-of-region) | ||
| 131 | ;; (global-set-key "\C-c\C-zu" 'browse-url) | 158 | ;; (global-set-key "\C-c\C-zu" 'browse-url) |
| 132 | ;; (global-set-key "\C-c\C-zv" 'browse-url-of-file) | 159 | ;; (global-set-key "\C-c\C-zv" 'browse-url-of-file) |
| 133 | ;; (add-hook 'dired-mode-hook | 160 | ;; (add-hook 'dired-mode-hook |
| 134 | ;; (function (lambda () | 161 | ;; (function (lambda () |
| 135 | ;; (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file)))) | 162 | ;; (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file)))) |
| 136 | 163 | ||
| @@ -144,150 +171,47 @@ | |||
| 144 | 171 | ||
| 145 | ;; Use the Emacs w3 browser when not running under X11: | 172 | ;; Use the Emacs w3 browser when not running under X11: |
| 146 | ;; (or (eq window-system 'x) | 173 | ;; (or (eq window-system 'x) |
| 147 | ;; (setq browse-url-browser-function 'browse-url-w3)) | 174 | ;; (setq browse-url-browser-function 'browse-url-w3)) |
| 148 | 175 | ||
| 149 | ;; To always save modified buffers before displaying the file in a browser: | 176 | ;; To always save modified buffers before displaying the file in a browser: |
| 150 | ;; (setq browse-url-save-file t) | 177 | ;; (setq browse-url-save-file t) |
| 151 | 178 | ||
| 152 | ;; To get round the Netscape caching problem, you could EITHER have | 179 | ;; To get round the Netscape caching problem, you could EITHER have |
| 153 | ;; write-file in html-helper-mode make Netscape reload the document: | 180 | ;; write-file in html-helper-mode make Netscape reload the document: |
| 154 | ;; | 181 | ;; |
| 155 | ;; (autoload 'browse-url-netscape-reload "browse-url" | 182 | ;; (autoload 'browse-url-netscape-reload "browse-url" |
| 156 | ;; "Ask a WWW browser to redisplay the current file." t) | 183 | ;; "Ask a WWW browser to redisplay the current file." t) |
| 157 | ;; (add-hook 'html-helper-mode-hook | 184 | ;; (add-hook 'html-helper-mode-hook |
| 158 | ;; (function (lambda () | 185 | ;; (function (lambda () |
| 159 | ;; (add-hook 'local-write-file-hooks | 186 | ;; (add-hook 'local-write-file-hooks |
| 160 | ;; (function (lambda () | 187 | ;; (function (lambda () |
| 161 | ;; (let ((local-write-file-hooks)) | 188 | ;; (let ((local-write-file-hooks)) |
| 162 | ;; (save-buffer)) | 189 | ;; (save-buffer)) |
| 163 | ;; (browse-url-netscape-reload) | 190 | ;; (browse-url-netscape-reload) |
| 164 | ;; t)) ; => file written by hook | 191 | ;; t)) ; => file written by hook |
| 165 | ;; t)))) ; append to l-w-f-hooks | 192 | ;; t)))) ; append to l-w-f-hooks |
| 166 | ;; | 193 | ;; |
| 167 | ;; OR have browse-url-of-file ask Netscape to load and then reload the | 194 | ;; OR have browse-url-of-file ask Netscape to load and then reload the |
| 168 | ;; file: | 195 | ;; file: |
| 169 | ;; | 196 | ;; |
| 170 | ;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload) | 197 | ;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload) |
| 171 | 198 | ||
| 172 | ;; You may also want to customise browse-url-netscape-arguments, e.g. | 199 | ;; You may also want to customise browse-url-netscape-arguments, e.g. |
| 173 | ;; (setq browse-url-netscape-arguments '("-install")) | 200 | ;; (setq browse-url-netscape-arguments '("-install")) |
| 174 | ;; | 201 | ;; |
| 175 | ;; or similarly for the other browsers. | 202 | ;; or similarly for the other browsers. |
| 176 | |||
| 177 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 178 | ;;; Change Log: | ||
| 179 | |||
| 180 | ;; 0.00 03 Apr 1995 Denis Howe <dbh@doc.ic.ac.uk> | ||
| 181 | ;; Created. | ||
| 182 | |||
| 183 | ;; 0.01 04 Apr 1995 | ||
| 184 | ;; All names start with "browse-url-". Added provide. | ||
| 185 | |||
| 186 | ;; 0.02 05 Apr 1995 | ||
| 187 | ;; Save file at start of browse-url-of-file. | ||
| 188 | ;; Use start-process instead of start-process-shell-command. | ||
| 189 | |||
| 190 | ;; 0.03 06 Apr 1995 | ||
| 191 | ;; Add browse-url-netscape-reload, browse-url-netscape-send. | ||
| 192 | ;; browse-url-of-file save file option. | ||
| 193 | |||
| 194 | ;; 0.04 08 Apr 1995 | ||
| 195 | ;; b-u-file-url separate function. Change b-u-filename-alist | ||
| 196 | ;; default. | ||
| 197 | |||
| 198 | ;; 0.05 09 Apr 1995 | ||
| 199 | ;; Added b-u-of-file-hook. | ||
| 200 | |||
| 201 | ;; 0.06 11 Apr 1995 | ||
| 202 | ;; Improved .emacs suggestions and documentation. | ||
| 203 | |||
| 204 | ;; 0.07 13 Apr 1995 | ||
| 205 | ;; Added browse-url-interactive-arg optional prompt. | ||
| 206 | |||
| 207 | ;; 0.08 18 Apr 1995 | ||
| 208 | ;; Exclude final "." from browse-url-regexp. | ||
| 209 | |||
| 210 | ;; 0.09 21 Apr 1995 | ||
| 211 | ;; Added mouse-set-point to browse-url-interactive-arg. | ||
| 212 | |||
| 213 | ;; 0.10 24 Apr 1995 | ||
| 214 | ;; Added Mosaic signal sending variations. | ||
| 215 | ;; Thanks Brian K Servis <servis@ecn.purdue.edu>. | ||
| 216 | ;; Don't use xprop for Netscape. | ||
| 217 | |||
| 218 | ;; 0.11 25 Apr 1995 | ||
| 219 | ;; Fix reading of ~/.mosaicpid. Thanks Dag.H.Wanvik@kvatro.no. | ||
| 220 | 203 | ||
| 221 | ;; 0.12 27 Apr 1995 | 204 | ;; To invoke different browsers for different URLs: |
| 222 | ;; Interactive prefix arg => URL *after* point. | 205 | ;; (setq browse-url-browser-function '(("^mailto:" . browse-url-mail) |
| 223 | ;; Thanks Michelangelo Grigni <mic@cs.ucsd.edu>. | 206 | ;; ("." . browse-url-netscape))) |
| 224 | ;; Added IXI Mosaic support. | ||
| 225 | ;; Thanks David Karr <dkarr@nmo.gtegsc.com>. | ||
| 226 | |||
| 227 | ;; 0.13 28 Apr 1995 | ||
| 228 | ;; Exclude final [,;] from browse-url-regexp. | ||
| 229 | |||
| 230 | ;; 0.14 02 May 1995 | ||
| 231 | ;; Provide browser argument variables. | ||
| 232 | |||
| 233 | ;; 0.15 07 May 1995 | ||
| 234 | ;; More Netscape options. Thanks Peter Arius | ||
| 235 | ;; <arius@immd2.informatik.uni-erlangen.de>. | ||
| 236 | |||
| 237 | ;; 0.16 17 May 1995 | ||
| 238 | ;; Added browse-url-at-mouse. | ||
| 239 | ;; Thanks Wayne Mesard <wmesard@sgi.com> | ||
| 240 | |||
| 241 | ;; 0.17 27 Jun 1995 | ||
| 242 | ;; Renamed browse-url-at-point to browse-url-url-at-point. | ||
| 243 | ;; Added browse-url-at-point. | ||
| 244 | ;; Thanks Jonathan Cano <cano@patch.tandem.com>. | ||
| 245 | |||
| 246 | ;; 0.18 16 Aug 1995 | ||
| 247 | ;; Fixed call to browse-url-url-at-point in browse-url-at-point. | ||
| 248 | ;; Thanks Eric Ding <ericding@San-Jose.ate.slb.com>. | ||
| 249 | |||
| 250 | ;; 0.19 24 Aug 1995 | ||
| 251 | ;; Improved documentation. | ||
| 252 | ;; Thanks Kevin Rodgers <kevin.rodgers@ihs.com>. | ||
| 253 | |||
| 254 | ;; 0.20 31 Aug 1995 | ||
| 255 | ;; browse-url-of-buffer to handle file-less buffers. | ||
| 256 | ;; browse-url-of-dired-file browses current file in dired. | ||
| 257 | ;; Thanks Kevin Rodgers <kevin.rodgers@ihs.com>. | ||
| 258 | |||
| 259 | ;; 0.21 09 Sep 1995 | ||
| 260 | ;; XMosaic CCI functions. | ||
| 261 | ;; Thanks Marc Furrer <Marc.Furrer@di.epfl.ch>. | ||
| 262 | |||
| 263 | ;; 0.22 13 Sep 1995 | ||
| 264 | ;; Fixed new-window documentation and added to browse-url-cci. | ||
| 265 | ;; Thanks Dilip Sequeira <djs@dcs.ed.ac.uk>. | ||
| 266 | 207 | ||
| 267 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 208 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 268 | ;;; Code: | 209 | ;;; Code: |
| 269 | 210 | ||
| 270 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 271 | ;; Variables | ||
| 272 | |||
| 273 | (eval-when-compile (require 'dired)) | 211 | (eval-when-compile (require 'dired)) |
| 274 | 212 | ||
| 275 | (defvar browse-url-path-regexp | 213 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 276 | "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" | 214 | ;; Variables |
| 277 | "A regular expression probably matching the host, path or e-mail | ||
| 278 | part of a URL.") | ||
| 279 | |||
| 280 | (defvar browse-url-short-regexp | ||
| 281 | (concat "[-A-Za-z0-9.]+" browse-url-path-regexp) | ||
| 282 | "A regular expression probably matching a URL without an access scheme. | ||
| 283 | Hostname matching is stricter in this case than for | ||
| 284 | ``browse-url-regexp''.") | ||
| 285 | |||
| 286 | (defvar browse-url-regexp | ||
| 287 | (concat | ||
| 288 | "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)" | ||
| 289 | browse-url-path-regexp) | ||
| 290 | "A regular expression probably matching a complete URL.") | ||
| 291 | 215 | ||
| 292 | ;;;###autoload | 216 | ;;;###autoload |
| 293 | (defgroup browse-url nil | 217 | (defgroup browse-url nil |
| @@ -300,7 +224,12 @@ Hostname matching is stricter in this case than for | |||
| 300 | "*Function to display the current buffer in a WWW browser. | 224 | "*Function to display the current buffer in a WWW browser. |
| 301 | This is used by the `browse-url-at-point', `browse-url-at-mouse', and | 225 | This is used by the `browse-url-at-point', `browse-url-at-mouse', and |
| 302 | `browse-url-of-file' commands. | 226 | `browse-url-of-file' commands. |
| 303 | The function should take one argument, an URL." | 227 | |
| 228 | If the value is not a function it should be a list of pairs | ||
| 229 | (REGEXP.FUNCTION). In this case the function called will be the one | ||
| 230 | associated with the first REGEXP which matches the current URL. The | ||
| 231 | function is passed the URL and any other args of `browse-url'. The last | ||
| 232 | regexp should probably be \".\" to specify a default browser." | ||
| 304 | :type 'function | 233 | :type 'function |
| 305 | :group 'browse-url) | 234 | :group 'browse-url) |
| 306 | 235 | ||
| @@ -317,7 +246,7 @@ The function should take one argument, an URL." | |||
| 317 | (defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments | 246 | (defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments |
| 318 | "*A list of strings to pass to Netscape when it starts up. | 247 | "*A list of strings to pass to Netscape when it starts up. |
| 319 | Defaults to the value of `browse-url-netscape-arguments' at the time | 248 | Defaults to the value of `browse-url-netscape-arguments' at the time |
| 320 | browse-url is loaded." | 249 | `browse-url' is loaded." |
| 321 | :type '(repeat (string :tag "Argument")) | 250 | :type '(repeat (string :tag "Argument")) |
| 322 | :group 'browse-url) | 251 | :group 'browse-url) |
| 323 | 252 | ||
| @@ -329,18 +258,53 @@ Netscape version 1.1N or later or XMosaic version 2.5 or later." | |||
| 329 | :type 'boolean | 258 | :type 'boolean |
| 330 | :group 'browse-url) | 259 | :group 'browse-url) |
| 331 | 260 | ||
| 261 | (defcustom browse-url-netscape-display nil | ||
| 262 | "*The X display on which Netscape is running if different from | ||
| 263 | Emacs's display." | ||
| 264 | :type 'string | ||
| 265 | :group 'browse-url) | ||
| 266 | |||
| 332 | (defcustom browse-url-mosaic-arguments nil | 267 | (defcustom browse-url-mosaic-arguments nil |
| 333 | "*A list of strings to pass to Mosaic as arguments." | 268 | "*A list of strings to pass to Mosaic as arguments." |
| 334 | :type '(repeat (string :tag "Argument")) | 269 | :type '(repeat (string :tag "Argument")) |
| 335 | :group 'browse-url) | 270 | :group 'browse-url) |
| 336 | 271 | ||
| 272 | (defvar browse-url-path-regexp | ||
| 273 | "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+" | ||
| 274 | "A regular expression probably matching the host, path or e-mail part of a URL.") | ||
| 275 | |||
| 276 | (defvar browse-url-short-regexp | ||
| 277 | (concat "[-A-Za-z0-9.]+" browse-url-path-regexp) | ||
| 278 | "A regular expression probably matching a URL without an access scheme. | ||
| 279 | Hostname matching is stricter in this case than for | ||
| 280 | ``browse-url-regexp''.") | ||
| 281 | |||
| 282 | (defvar browse-url-regexp | ||
| 283 | (concat | ||
| 284 | "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)" | ||
| 285 | browse-url-path-regexp) | ||
| 286 | "A regular expression probably matching a complete URL.") | ||
| 287 | |||
| 288 | (defvar browse-url-markedup-regexp | ||
| 289 | "<URL:[^>]+>" | ||
| 290 | "A regular expression matching a URL marked up per RFC1738. | ||
| 291 | This may be broken across lines.") | ||
| 292 | |||
| 337 | (defvar browse-url-filename-alist | 293 | (defvar browse-url-filename-alist |
| 338 | '(("^/+" . "file:/")) | 294 | '(("^/+" . "file:/")) |
| 339 | "An alist of (REGEXP . STRING) pairs. | 295 | "An alist of (REGEXP . STRING) pairs. |
| 340 | Any substring of a filename matching one of the REGEXPs is replaced by | 296 | Any substring of a filename matching one of the REGEXPs is replaced by |
| 341 | the corresponding STRING. All pairs are applied in the order given. | 297 | the corresponding STRING. All pairs are applied in the order given. |
| 342 | The default value prepends `file:' to any path beginning with `/'. | 298 | The default value prepends `file:' to any path beginning with `/'. |
| 343 | Used by the `browse-url-of-file' command.") | 299 | Used by the `browse-url-of-file' command. |
| 300 | |||
| 301 | For example, to map EFS filenames to URLs: | ||
| 302 | |||
| 303 | (setq browse-url-filename-alist | ||
| 304 | '((\"/webmaster@webserver:/home/www/html/\" . | ||
| 305 | \"http://www.acme.co.uk/\") | ||
| 306 | (\"^/+\" . \"file:/\"))) | ||
| 307 | ") | ||
| 344 | 308 | ||
| 345 | (defvar browse-url-save-file nil | 309 | (defvar browse-url-save-file nil |
| 346 | "If non-nil, save the buffer before displaying its file. | 310 | "If non-nil, save the buffer before displaying its file. |
| @@ -355,9 +319,9 @@ file rather than displaying a cached copy.") | |||
| 355 | 319 | ||
| 356 | (defvar browse-url-usr1-signal | 320 | (defvar browse-url-usr1-signal |
| 357 | (if (and (boundp 'emacs-major-version) | 321 | (if (and (boundp 'emacs-major-version) |
| 358 | (or (> emacs-major-version 19) (>= emacs-minor-version 29))) | 322 | (or (> emacs-major-version 19) (>= emacs-minor-version 29))) |
| 359 | 'SIGUSR1 ; Why did I think this was in lower case before? | 323 | 'SIGUSR1 ; Why did I think this was in lower case before? |
| 360 | 30) ; Check /usr/include/signal.h. | 324 | 30) ; Check /usr/include/signal.h. |
| 361 | "The argument to `signal-process' for sending SIGUSR1 to XMosaic. | 325 | "The argument to `signal-process' for sending SIGUSR1 to XMosaic. |
| 362 | Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer | 326 | Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer |
| 363 | which is 30 on SunOS and 16 on HP-UX and Solaris.") | 327 | which is 30 on SunOS and 16 on HP-UX and Solaris.") |
| @@ -375,22 +339,99 @@ enabled. The port number should be set in `browse-url-CCI-port'.") | |||
| 375 | (defvar browse-url-temp-file-name nil) | 339 | (defvar browse-url-temp-file-name nil) |
| 376 | (make-variable-buffer-local 'browse-url-temp-file-name) | 340 | (make-variable-buffer-local 'browse-url-temp-file-name) |
| 377 | 341 | ||
| 342 | (defcustom browse-url-xterm-program "xterm" | ||
| 343 | "*The name of the terminal emulator used by `browse-url-lynx-xterm'. | ||
| 344 | This might, for instance, be a separate colour version of xterm." | ||
| 345 | :type 'string | ||
| 346 | :group 'browse-url) | ||
| 347 | |||
| 348 | (defcustom browse-url-xterm-args nil | ||
| 349 | "*A list of strings defining options for `browse-url-xterm-program'. | ||
| 350 | These might set its size, for instance." | ||
| 351 | :type '(repeat (string :tag "Argument")) | ||
| 352 | :group 'browse-url) | ||
| 353 | |||
| 354 | (defcustom browse-url-gnudoit-program "gnudoit" | ||
| 355 | "*The name of the `gnudoit' program used by `browse-url-w3-gnudoit'." | ||
| 356 | :type 'string | ||
| 357 | :group 'browse-url) | ||
| 358 | |||
| 359 | (defcustom browse-url-gnudoit-args '("-q") | ||
| 360 | "*A list of strings defining options for `browse-url-gnudoit-program'. | ||
| 361 | These might set the port, for instance." | ||
| 362 | :type '(repeat (string :tag "Argument")) | ||
| 363 | :group 'browse-url) | ||
| 364 | |||
| 365 | (defcustom browse-url-generic-program nil | ||
| 366 | "*The name of the browser program used by `browse-url-generic'." | ||
| 367 | :type 'string | ||
| 368 | :group 'browse-url) | ||
| 369 | |||
| 370 | (defcustom browse-url-generic-args nil | ||
| 371 | "*A list of strings defining options for `browse-url-generic-program'." | ||
| 372 | :type '(repeat (string :tag "Argument")) | ||
| 373 | :group 'browse-url) | ||
| 374 | |||
| 378 | (defvar browse-url-temp-file-list '()) | 375 | (defvar browse-url-temp-file-list '()) |
| 379 | 376 | ||
| 380 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 377 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 381 | ;; URL input | 378 | ;; URL input |
| 382 | 379 | ||
| 383 | ;; thingatpt.el doesn't work for complex regexps | ||
| 384 | |||
| 385 | (defun browse-url-url-at-point () | 380 | (defun browse-url-url-at-point () |
| 386 | "Return the URL around or before point. | 381 | "Return the URL around or before point. |
| 387 | Search backwards for the start of a URL ending at or after | 382 | Search backwards for the start of a URL ending at or after |
| 388 | point. If no URL found, return the empty string. | 383 | point. If no URL found, return the empty string. The |
| 389 | A file name is also acceptable, and `http://' will be prepended to it." | 384 | access scheme, `http://' will be prepended if absent." |
| 390 | (or (thing-at-point 'url) | 385 | (let ((url "") short strip) |
| 391 | (let ((file (thing-at-point 'filename))) | 386 | (if (or (setq strip (browse-url-looking-at browse-url-markedup-regexp)) |
| 392 | (if file (concat "http://" file))) | 387 | (browse-url-looking-at browse-url-regexp) |
| 393 | "")) | 388 | ;; Access scheme omitted? |
| 389 | (setq short (browse-url-looking-at browse-url-short-regexp))) | ||
| 390 | (progn | ||
| 391 | (setq url (buffer-substring-no-properties (match-beginning 0) | ||
| 392 | (match-end 0))) | ||
| 393 | (and strip (setq url (substring url 5 -1))) ; Drop "<URL:" & ">" | ||
| 394 | ;; strip whitespace | ||
| 395 | (while (string-match "\\s +\\|\n+" url) | ||
| 396 | (setq url (replace-match "" t t url))) | ||
| 397 | (and short (setq url (concat (if (string-match "@" url) | ||
| 398 | "mailto:" "http://") url))))) | ||
| 399 | url)) | ||
| 400 | |||
| 401 | ;; thingatpt.el doesn't work for complex regexps. This should work | ||
| 402 | ;; for almost any regexp wherever we are in the match. To do a | ||
| 403 | ;; perfect job for any arbitrary regexp would mean testing every | ||
| 404 | ;; position before point. Regexp searches won't find matches that | ||
| 405 | ;; straddle the start position so we search forwards once and then | ||
| 406 | ;; back repeatedly and then back up a char at a time. | ||
| 407 | |||
| 408 | (defun browse-url-looking-at (regexp) | ||
| 409 | "Return non-nil if point is in or just after a match for REGEXP. | ||
| 410 | Set the match data from the earliest such match ending at or after | ||
| 411 | point." | ||
| 412 | (save-excursion | ||
| 413 | (let ((old-point (point)) match) | ||
| 414 | (and (looking-at regexp) | ||
| 415 | (>= (match-end 0) old-point) | ||
| 416 | (setq match (point))) | ||
| 417 | ;; Search back repeatedly from end of next match. | ||
| 418 | ;; This may fail if next match ends before this match does. | ||
| 419 | (re-search-forward regexp nil 'limit) | ||
| 420 | (while (and (re-search-backward regexp nil t) | ||
| 421 | (or (> (match-beginning 0) old-point) | ||
| 422 | (and (looking-at regexp) ; Extend match-end past search start | ||
| 423 | (>= (match-end 0) old-point) | ||
| 424 | (setq match (point)))))) | ||
| 425 | (if (not match) nil | ||
| 426 | (goto-char match) | ||
| 427 | ;; Back up a char at a time in case search skipped | ||
| 428 | ;; intermediate match straddling search start pos. | ||
| 429 | (while (and (not (bobp)) | ||
| 430 | (progn (backward-char 1) (looking-at regexp)) | ||
| 431 | (>= (match-end 0) old-point) | ||
| 432 | (setq match (point)))) | ||
| 433 | (goto-char match) | ||
| 434 | (looking-at regexp))))) | ||
| 394 | 435 | ||
| 395 | ;; Having this as a separate function called by the browser-specific | 436 | ;; Having this as a separate function called by the browser-specific |
| 396 | ;; functions allows them to be stand-alone commands, making it easier | 437 | ;; functions allows them to be stand-alone commands, making it easier |
| @@ -400,7 +441,7 @@ A file name is also acceptable, and `http://' will be prepended to it." | |||
| 400 | "Read a URL from the minibuffer, prompting with PROMPT. | 441 | "Read a URL from the minibuffer, prompting with PROMPT. |
| 401 | Default to the URL at or before point. If invoke with a mouse button, | 442 | Default to the URL at or before point. If invoke with a mouse button, |
| 402 | set point to the position clicked first. Return a list for use in | 443 | set point to the position clicked first. Return a list for use in |
| 403 | `interactive' containing the URL and browse-url-new-window-p or its | 444 | `interactive' containing the URL and `browse-url-new-window-p' or its |
| 404 | negation if a prefix argument was given." | 445 | negation if a prefix argument was given." |
| 405 | (let ((event (elt (this-command-keys) 0))) | 446 | (let ((event (elt (this-command-keys) 0))) |
| 406 | (and (listp event) (mouse-set-point event))) | 447 | (and (listp event) (mouse-set-point event))) |
| @@ -416,20 +457,20 @@ negation if a prefix argument was given." | |||
| 416 | "Ask a WWW browser to display FILE. | 457 | "Ask a WWW browser to display FILE. |
| 417 | Display the current buffer's file if FILE is nil or if called | 458 | Display the current buffer's file if FILE is nil or if called |
| 418 | interactively. Turn the filename into a URL with function | 459 | interactively. Turn the filename into a URL with function |
| 419 | browse-url-file-url. Pass the URL to a browser using variable | 460 | `browse-url-file-url'. Pass the URL to a browser using the |
| 420 | `browse-url-browser-function' then run `browse-url-of-file-hook'." | 461 | `browse-url' function then run `browse-url-of-file-hook'." |
| 421 | (interactive) | 462 | (interactive) |
| 422 | (or file | 463 | (or file |
| 423 | (setq file (buffer-file-name)) | 464 | (setq file (buffer-file-name)) |
| 424 | (error "Current buffer has no file")) | 465 | (error "Current buffer has no file")) |
| 425 | (let ((buf (get-file-buffer file))) | 466 | (let ((buf (get-file-buffer file))) |
| 426 | (if buf | 467 | (if buf |
| 427 | (save-excursion | 468 | (save-excursion |
| 428 | (set-buffer buf) | 469 | (set-buffer buf) |
| 429 | (cond ((not (buffer-modified-p))) | 470 | (cond ((not (buffer-modified-p))) |
| 430 | (browse-url-save-file (save-buffer)) | 471 | (browse-url-save-file (save-buffer)) |
| 431 | (t (message "%s modified since last save" file)))))) | 472 | (t (message "%s modified since last save" file)))))) |
| 432 | (funcall browse-url-browser-function (browse-url-file-url file)) | 473 | (browse-url (browse-url-file-url file)) |
| 433 | (run-hooks 'browse-url-of-file-hook)) | 474 | (run-hooks 'browse-url-of-file-hook)) |
| 434 | 475 | ||
| 435 | (defun browse-url-file-url (file) | 476 | (defun browse-url-file-url (file) |
| @@ -447,9 +488,9 @@ Convert EFS file names of the form /USER@HOST:PATH to ftp://HOST/PATH." | |||
| 447 | (let ((maps browse-url-filename-alist)) | 488 | (let ((maps browse-url-filename-alist)) |
| 448 | (while maps | 489 | (while maps |
| 449 | (let* ((map (car maps)) | 490 | (let* ((map (car maps)) |
| 450 | (from-re (car map)) | 491 | (from-re (car map)) |
| 451 | (to-string (cdr map))) | 492 | (to-string (cdr map))) |
| 452 | (setq maps (cdr maps)) | 493 | (setq maps (cdr maps)) |
| 453 | (and (string-match from-re file) | 494 | (and (string-match from-re file) |
| 454 | (setq file (replace-match to-string t t file)))))) | 495 | (setq file (replace-match to-string t t file)))))) |
| 455 | ;; Check for EFS path | 496 | ;; Check for EFS path |
| @@ -462,22 +503,26 @@ Convert EFS file names of the form /USER@HOST:PATH to ftp://HOST/PATH." | |||
| 462 | ;;;###autoload | 503 | ;;;###autoload |
| 463 | (defun browse-url-of-buffer (&optional buffer) | 504 | (defun browse-url-of-buffer (&optional buffer) |
| 464 | "Ask a WWW browser to display BUFFER. | 505 | "Ask a WWW browser to display BUFFER. |
| 465 | Display the current buffer if BUFFER is nil." | 506 | Display the current buffer if BUFFER is nil. Display only the |
| 507 | currently visible part of BUFFER (from a temporary file) if buffer is | ||
| 508 | narrowed." | ||
| 466 | (interactive) | 509 | (interactive) |
| 467 | (save-excursion | 510 | (save-excursion |
| 468 | (and buffer (set-buffer buffer)) | 511 | (and buffer (set-buffer buffer)) |
| 469 | (let ((file-name | 512 | (let ((file-name |
| 470 | (or buffer-file-name | 513 | ;; Ignore real name if restricted |
| 471 | (and (boundp 'dired-directory) dired-directory)))) | 514 | (and (= (- (point-max) (point-min)) (buffer-size)) |
| 515 | (or buffer-file-name | ||
| 516 | (and (boundp 'dired-directory) dired-directory))))) | ||
| 472 | (or file-name | 517 | (or file-name |
| 473 | (progn | 518 | (progn |
| 474 | (or browse-url-temp-file-name | 519 | (or browse-url-temp-file-name |
| 475 | (setq browse-url-temp-file-name | 520 | (setq browse-url-temp-file-name |
| 476 | (make-temp-name | 521 | (make-temp-name |
| 477 | (expand-file-name (buffer-name) | 522 | (expand-file-name (buffer-name) |
| 478 | (or (getenv "TMPDIR") "/tmp"))) | 523 | (or (getenv "TMPDIR") "/tmp"))) |
| 479 | browse-url-temp-file-list | 524 | browse-url-temp-file-list |
| 480 | (cons browse-url-temp-file-name | 525 | (cons browse-url-temp-file-name |
| 481 | browse-url-temp-file-list))) | 526 | browse-url-temp-file-list))) |
| 482 | (setq file-name browse-url-temp-file-name) | 527 | (setq file-name browse-url-temp-file-name) |
| 483 | (write-region (point-min) (point-max) file-name nil 'no-message))) | 528 | (write-region (point-min) (point-max) file-name nil 'no-message))) |
| @@ -490,19 +535,19 @@ Display the current buffer if BUFFER is nil." | |||
| 490 | ;; browse-url-temp-file-list is not affected. | 535 | ;; browse-url-temp-file-list is not affected. |
| 491 | (let ((file-name (or temp-file-name browse-url-temp-file-name))) | 536 | (let ((file-name (or temp-file-name browse-url-temp-file-name))) |
| 492 | (if (and file-name (file-exists-p file-name)) | 537 | (if (and file-name (file-exists-p file-name)) |
| 493 | (progn | 538 | (progn |
| 494 | (delete-file file-name) | 539 | (delete-file file-name) |
| 495 | (if (null temp-file-name) | 540 | (if (null temp-file-name) |
| 496 | (setq browse-url-temp-file-list | 541 | (setq browse-url-temp-file-list |
| 497 | (delete browse-url-temp-file-name | 542 | (delete browse-url-temp-file-name |
| 498 | browse-url-temp-file-list))))))) | 543 | browse-url-temp-file-list))))))) |
| 499 | 544 | ||
| 500 | (defun browse-url-delete-temp-file-list () | 545 | (defun browse-url-delete-temp-file-list () |
| 501 | ;; Delete all elements of browse-url-temp-file-list. | 546 | ;; Delete all elements of browse-url-temp-file-list. |
| 502 | (while browse-url-temp-file-list | 547 | (while browse-url-temp-file-list |
| 503 | (browse-url-delete-temp-file (car browse-url-temp-file-list)) | 548 | (browse-url-delete-temp-file (car browse-url-temp-file-list)) |
| 504 | (setq browse-url-temp-file-list | 549 | (setq browse-url-temp-file-list |
| 505 | (cdr browse-url-temp-file-list)))) | 550 | (cdr browse-url-temp-file-list)))) |
| 506 | 551 | ||
| 507 | (add-hook 'kill-buffer-hook 'browse-url-delete-temp-file) | 552 | (add-hook 'kill-buffer-hook 'browse-url-delete-temp-file) |
| 508 | (add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list) | 553 | (add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list) |
| @@ -513,17 +558,44 @@ Display the current buffer if BUFFER is nil." | |||
| 513 | (interactive) | 558 | (interactive) |
| 514 | (browse-url-of-file (dired-get-filename))) | 559 | (browse-url-of-file (dired-get-filename))) |
| 515 | 560 | ||
| 561 | ;;;###autoload | ||
| 562 | (defun browse-url-of-region (min max) | ||
| 563 | "Ask a WWW browser to display the current region." | ||
| 564 | (interactive "r") | ||
| 565 | (save-excursion | ||
| 566 | (save-restriction | ||
| 567 | (narrow-to-region (mark) (point)) | ||
| 568 | (browse-url-of-buffer)))) | ||
| 569 | |||
| 516 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 570 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 517 | ;; Browser-independant commands | 571 | ;; Browser-independent commands |
| 518 | 572 | ||
| 519 | ;; A generic command to call the current b-u-browser-function | 573 | ;; A generic command to call the current browse-url-browser-function |
| 520 | 574 | ||
| 575 | ;;;###autoload | ||
| 521 | (defun browse-url (&rest args) | 576 | (defun browse-url (&rest args) |
| 522 | "Ask a WWW browser to load URL. | 577 | "Ask a WWW browser to load URL. |
| 523 | Prompts for a URL, defaulting to the URL at or before point. Variable | 578 | Prompts for a URL, defaulting to the URL at or before point. Variable |
| 524 | `browse-url-browser-function' says which browser to use." | 579 | `browse-url-browser-function' says which browser to use." |
| 525 | (interactive (browse-url-interactive-arg "URL: ")) | 580 | (interactive (browse-url-interactive-arg "URL: ")) |
| 526 | (apply browse-url-browser-function args)) | 581 | (if (consp browse-url-browser-function) |
| 582 | (browse-url-choose-browser args) | ||
| 583 | (apply browse-url-browser-function args))) | ||
| 584 | |||
| 585 | (defun browse-url-choose-browser (url &rest args) | ||
| 586 | "Pass URL to a browser function chosen. | ||
| 587 | This is done according to the association list in variable | ||
| 588 | `browse-url-browser-function'." | ||
| 589 | (let ((blist browse-url-browser-function) | ||
| 590 | re bf) | ||
| 591 | (while (consp blist) | ||
| 592 | (setq re (car (car blist)) | ||
| 593 | bf (cdr (car blist)) | ||
| 594 | blist (cdr blist)) | ||
| 595 | (if (string-match re url) | ||
| 596 | (progn (apply bf url args) (setq blist t)))) | ||
| 597 | (or blist | ||
| 598 | (error "No browser in browse-url-browser-function matching URL %s" url)))) | ||
| 527 | 599 | ||
| 528 | ;;;###autoload | 600 | ;;;###autoload |
| 529 | (defun browse-url-at-point () | 601 | (defun browse-url-at-point () |
| @@ -531,9 +603,7 @@ Prompts for a URL, defaulting to the URL at or before point. Variable | |||
| 531 | Doesn't let you edit the URL like browse-url. Variable | 603 | Doesn't let you edit the URL like browse-url. Variable |
| 532 | `browse-url-browser-function' says which browser to use." | 604 | `browse-url-browser-function' says which browser to use." |
| 533 | (interactive) | 605 | (interactive) |
| 534 | (funcall browse-url-browser-function (browse-url-url-at-point))) | 606 | (browse-url (browse-url-url-at-point))) |
| 535 | |||
| 536 | ;; Define these if not already defined (XEmacs compatibility) | ||
| 537 | 607 | ||
| 538 | (defun browse-url-event-buffer (event) | 608 | (defun browse-url-event-buffer (event) |
| 539 | (window-buffer (posn-window (event-start event)))) | 609 | (window-buffer (posn-window (event-start event)))) |
| @@ -555,30 +625,38 @@ to use." | |||
| 555 | (let ((url (browse-url-url-at-point))) | 625 | (let ((url (browse-url-url-at-point))) |
| 556 | (if (string-equal url "") | 626 | (if (string-equal url "") |
| 557 | (error "No URL found")) | 627 | (error "No URL found")) |
| 558 | (funcall browse-url-browser-function url)))) | 628 | (browse-url url)))) |
| 559 | 629 | ||
| 560 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 630 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 561 | ;; Browser-specific commands | 631 | ;; Browser-specific commands |
| 562 | 632 | ||
| 563 | ;; --- Netscape --- | 633 | ;; --- Netscape --- |
| 564 | 634 | ||
| 565 | ;; Put the correct DISPLAY value in the environment for Netscape | ||
| 566 | ;; launched from multi-display Emacs. | ||
| 567 | |||
| 568 | (defun browse-url-process-environment () | 635 | (defun browse-url-process-environment () |
| 569 | (let* ((device (and (fboundp 'selected-device) | 636 | "Set DISPLAY in the environment to the X display Netscape is running on. |
| 570 | (fboundp 'device-connection) | 637 | This is either the value of variable `browse-url-netscape-display' if |
| 571 | (selected-device))) | 638 | non-nil, or the same display as Emacs if different from the current |
| 572 | (display (and device (fboundp 'device-type) | 639 | environment, otherwise just use the current environment." |
| 573 | (eq (device-type device) 'x) | 640 | (let ((display (or browse-url-netscape-display (browse-url-emacs-display)))) |
| 574 | (not (equal (device-connection device) | ||
| 575 | (getenv "DISPLAY")))))) | ||
| 576 | (if display | 641 | (if display |
| 577 | ;; Attempt to run on the correct display | 642 | (cons (concat "DISPLAY=" display) process-environment) |
| 578 | (cons (concat "DISPLAY=" (device-connection device)) | ||
| 579 | process-environment) | ||
| 580 | process-environment))) | 643 | process-environment))) |
| 581 | 644 | ||
| 645 | (defun browse-url-emacs-display () | ||
| 646 | "Return the X display Emacs is running on. | ||
| 647 | This nil if the display is the same as the DISPLAY environment variable. | ||
| 648 | |||
| 649 | Actually Emacs could be using several screens on several displays, as | ||
| 650 | listed by (emacs-display-list) and (x-display-screens DISPLAY), this | ||
| 651 | just returns the display showing the selected frame. You got a | ||
| 652 | problem with that?" | ||
| 653 | (let (device display) | ||
| 654 | (and (fboundp 'selected-device) (fboundp 'device-type) (fboundp 'device-connection) | ||
| 655 | (setq device (selected-device)) | ||
| 656 | (eq (device-type device) 'x) | ||
| 657 | (setq display (device-connection device)) | ||
| 658 | (not (equal display (getenv "DISPLAY"))) | ||
| 659 | display))) | ||
| 582 | 660 | ||
| 583 | ;;;###autoload | 661 | ;;;###autoload |
| 584 | (defun browse-url-netscape (url &optional new-window) | 662 | (defun browse-url-netscape (url &optional new-window) |
| @@ -590,10 +668,10 @@ Default to the URL around or before point. The strings in variable | |||
| 590 | When called interactively, if variable `browse-url-new-window-p' is | 668 | When called interactively, if variable `browse-url-new-window-p' is |
| 591 | non-nil, load the document in a new Netscape window, otherwise use a | 669 | non-nil, load the document in a new Netscape window, otherwise use a |
| 592 | random existing one. A non-nil interactive prefix argument reverses | 670 | random existing one. A non-nil interactive prefix argument reverses |
| 593 | the effect of browse-url-new-window-p. | 671 | the effect of `browse-url-new-window-p'. |
| 594 | 672 | ||
| 595 | When called non-interactively, optional second argument NEW-WINDOW is | 673 | When called non-interactively, optional second argument NEW-WINDOW is |
| 596 | used instead of browse-url-new-window-p." | 674 | used instead of `browse-url-new-window-p'." |
| 597 | (interactive (browse-url-interactive-arg "Netscape URL: ")) | 675 | (interactive (browse-url-interactive-arg "Netscape URL: ")) |
| 598 | ;; URL encode any commas in the URL | 676 | ;; URL encode any commas in the URL |
| 599 | (while (string-match "," url) | 677 | (while (string-match "," url) |
| @@ -602,22 +680,24 @@ used instead of browse-url-new-window-p." | |||
| 602 | (process (apply 'start-process | 680 | (process (apply 'start-process |
| 603 | (concat "netscape " url) nil | 681 | (concat "netscape " url) nil |
| 604 | browse-url-netscape-program | 682 | browse-url-netscape-program |
| 605 | (append browse-url-netscape-arguments | 683 | (append browse-url-netscape-arguments |
| 606 | (if new-window '("-noraise")) | 684 | (if (string-equal "win32" window-system) |
| 607 | (list "-remote" | 685 | (list url) |
| 608 | (concat "openURL(" url | 686 | (if new-window '("-noraise")) |
| 609 | (if new-window ",new-window") | 687 | (list "-remote" |
| 610 | ")")))))) | 688 | (concat "openURL(" url |
| 689 | (if new-window ",new-window") | ||
| 690 | ")"))))))) | ||
| 611 | (set-process-sentinel process | 691 | (set-process-sentinel process |
| 612 | (list 'lambda '(process change) | 692 | (list 'lambda '(process change) |
| 613 | (list 'browse-url-netscape-sentinel 'process url))))) | 693 | (list 'browse-url-netscape-sentinel 'process url))))) |
| 614 | 694 | ||
| 615 | (defun browse-url-netscape-sentinel (process url) | 695 | (defun browse-url-netscape-sentinel (process url) |
| 616 | "Handle a change to the process communicating with Netscape." | 696 | "Handle a change to the process communicating with Netscape." |
| 617 | (or (eq (process-exit-status process) 0) | 697 | (or (eq (process-exit-status process) 0) |
| 618 | (let* ((process-environment (browse-url-process-environment))) | 698 | (let* ((process-environment (browse-url-process-environment))) |
| 619 | ;; Netscape not running - start it | 699 | ;; Netscape not running - start it |
| 620 | (message "Starting Netscape...") | 700 | (message "Starting Netscape...") |
| 621 | (apply 'start-process (concat "netscape" url) nil | 701 | (apply 'start-process (concat "netscape" url) nil |
| 622 | browse-url-netscape-program | 702 | browse-url-netscape-program |
| 623 | (append browse-url-netscape-startup-arguments (list url)))))) | 703 | (append browse-url-netscape-startup-arguments (list url)))))) |
| @@ -632,7 +712,7 @@ used instead of browse-url-new-window-p." | |||
| 632 | (let* ((process-environment (browse-url-process-environment))) | 712 | (let* ((process-environment (browse-url-process-environment))) |
| 633 | (apply 'start-process "netscape" nil | 713 | (apply 'start-process "netscape" nil |
| 634 | browse-url-netscape-program | 714 | browse-url-netscape-program |
| 635 | (append browse-url-netscape-arguments | 715 | (append browse-url-netscape-arguments |
| 636 | (list "-remote" command))))) | 716 | (list "-remote" command))))) |
| 637 | 717 | ||
| 638 | ;; --- Mosaic --- | 718 | ;; --- Mosaic --- |
| @@ -644,31 +724,31 @@ used instead of browse-url-new-window-p." | |||
| 644 | Default to the URL around or before point." | 724 | Default to the URL around or before point." |
| 645 | (interactive (browse-url-interactive-arg "Mosaic URL: ")) | 725 | (interactive (browse-url-interactive-arg "Mosaic URL: ")) |
| 646 | (let ((pidfile (expand-file-name "~/.mosaicpid")) | 726 | (let ((pidfile (expand-file-name "~/.mosaicpid")) |
| 647 | pid pidbuf) | 727 | pid pidbuf) |
| 648 | (if (file-readable-p pidfile) | 728 | (if (file-readable-p pidfile) |
| 649 | (save-excursion | 729 | (save-excursion |
| 650 | (find-file pidfile) | 730 | (find-file pidfile) |
| 651 | (goto-char (point-min)) | 731 | (goto-char (point-min)) |
| 652 | (setq pid (read (current-buffer))) | 732 | (setq pid (read (current-buffer))) |
| 653 | (kill-buffer nil))) | 733 | (kill-buffer nil))) |
| 654 | (if (and pid (zerop (signal-process pid 0))) ; Mosaic running | 734 | (if (and pid (zerop (signal-process pid 0))) ; Mosaic running |
| 655 | (save-excursion | 735 | (save-excursion |
| 656 | (find-file (format "/tmp/Mosaic.%d" pid)) | 736 | (find-file (format "/tmp/Mosaic.%d" pid)) |
| 657 | (erase-buffer) | 737 | (erase-buffer) |
| 658 | (insert "goto\n" url "\n") | 738 | (insert "goto\n" url "\n") |
| 659 | (save-buffer) | 739 | (save-buffer) |
| 660 | (kill-buffer nil) | 740 | (kill-buffer nil) |
| 661 | ;; Send signal SIGUSR to Mosaic | 741 | ;; Send signal SIGUSR to Mosaic |
| 662 | (message "Signalling Mosaic...") | 742 | (message "Signalling Mosaic...") |
| 663 | (signal-process pid browse-url-usr1-signal) | 743 | (signal-process pid browse-url-usr1-signal) |
| 664 | ;; Or you could try: | 744 | ;; Or you could try: |
| 665 | ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) | 745 | ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) |
| 666 | (message "Signalling Mosaic...done") | 746 | (message "Signalling Mosaic...done") |
| 667 | ) | 747 | ) |
| 668 | ;; Mosaic not running - start it | 748 | ;; Mosaic not running - start it |
| 669 | (message "Starting Mosaic...") | 749 | (message "Starting Mosaic...") |
| 670 | (apply 'start-process "xmosaic" nil "xmosaic" | 750 | (apply 'start-process "xmosaic" nil "xmosaic" |
| 671 | (append browse-url-mosaic-arguments (list url))) | 751 | (append browse-url-mosaic-arguments (list url))) |
| 672 | (message "Starting Mosaic...done")))) | 752 | (message "Starting Mosaic...done")))) |
| 673 | 753 | ||
| 674 | ;; --- Grail --- | 754 | ;; --- Grail --- |
| @@ -680,7 +760,7 @@ Default to the URL around or before point." | |||
| 680 | Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.") | 760 | Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.") |
| 681 | 761 | ||
| 682 | ;;;###autoload | 762 | ;;;###autoload |
| 683 | (defun browse-url-grail (url) | 763 | (defun browse-url-grail (url &optional new-window) |
| 684 | "Ask the Grail WWW browser to load URL. | 764 | "Ask the Grail WWW browser to load URL. |
| 685 | Default to the URL around or before point. Runs the program in the | 765 | Default to the URL around or before point. Runs the program in the |
| 686 | variable `browse-url-grail'." | 766 | variable `browse-url-grail'." |
| @@ -706,17 +786,17 @@ value of variable `browse-url-CCI-port', and enable `Accept requests'. | |||
| 706 | When called interactively, if variable `browse-url-new-window-p' is | 786 | When called interactively, if variable `browse-url-new-window-p' is |
| 707 | non-nil, load the document in a new browser window, otherwise use a | 787 | non-nil, load the document in a new browser window, otherwise use a |
| 708 | random existing one. A non-nil interactive prefix argument reverses | 788 | random existing one. A non-nil interactive prefix argument reverses |
| 709 | the effect of browse-url-new-window-p. | 789 | the effect of `browse-url-new-window-p'. |
| 710 | 790 | ||
| 711 | When called non-interactively, optional second argument NEW-WINDOW is | 791 | When called non-interactively, optional second argument NEW-WINDOW is |
| 712 | used instead of browse-url-new-window-p." | 792 | used instead of `browse-url-new-window-p'." |
| 713 | (interactive (browse-url-interactive-arg "Mosaic URL: ")) | 793 | (interactive (browse-url-interactive-arg "Mosaic URL: ")) |
| 714 | (open-network-stream "browse-url" " *browse-url*" | 794 | (open-network-stream "browse-url" " *browse-url*" |
| 715 | browse-url-CCI-host browse-url-CCI-port) | 795 | browse-url-CCI-host browse-url-CCI-port) |
| 716 | ;; Todo: start browser if fails | 796 | ;; Todo: start browser if fails |
| 717 | (process-send-string "browse-url" | 797 | (process-send-string "browse-url" |
| 718 | (concat "get url (" url ") output " | 798 | (concat "get url (" url ") output " |
| 719 | (if new-window "new" "current") "\r\n")) | 799 | (if new-window "new" "current") "\r\n")) |
| 720 | (process-send-string "browse-url" "disconnect\r\n") | 800 | (process-send-string "browse-url" "disconnect\r\n") |
| 721 | (delete-process "browse-url")) | 801 | (delete-process "browse-url")) |
| 722 | 802 | ||
| @@ -729,7 +809,7 @@ used instead of browse-url-new-window-p." | |||
| 729 | Default to the URL around or before point." | 809 | Default to the URL around or before point." |
| 730 | (interactive (browse-url-interactive-arg "IXI Mosaic URL: ")) | 810 | (interactive (browse-url-interactive-arg "IXI Mosaic URL: ")) |
| 731 | (start-process "tellw3b" nil "tellw3b" | 811 | (start-process "tellw3b" nil "tellw3b" |
| 732 | "-service WWW_BROWSER ixi_showurl " url)) | 812 | "-service WWW_BROWSER ixi_showurl " url)) |
| 733 | 813 | ||
| 734 | ;; --- W3 --- | 814 | ;; --- W3 --- |
| 735 | 815 | ||
| @@ -741,6 +821,17 @@ Default to the URL around or before point." | |||
| 741 | (interactive (browse-url-interactive-arg "W3 URL: ")) | 821 | (interactive (browse-url-interactive-arg "W3 URL: ")) |
| 742 | (w3-fetch url)) | 822 | (w3-fetch url)) |
| 743 | 823 | ||
| 824 | ;;;###autoload | ||
| 825 | (defun browse-url-w3-gnudoit (url &optional new-window) | ||
| 826 | ;; new-window ignored | ||
| 827 | "Ask another Emacs running gnuserv to load the URL using the W3 browser. | ||
| 828 | The `browse-url-gnudoit-program' program is used with options given by | ||
| 829 | `browse-url-gnudoit-args'. Default to the URL around or before point." | ||
| 830 | (interactive (browse-url-interactive-arg "W3 URL: ")) | ||
| 831 | (apply 'start-process (concat "gnudoit:" url) nil | ||
| 832 | browse-url-gnudoit-program | ||
| 833 | (append browse-url-gnudoit-args (list (concat "(w3-fetch \"" url "\")") "(raise-frame)")))) | ||
| 834 | |||
| 744 | ;; --- Lynx in an xterm --- | 835 | ;; --- Lynx in an xterm --- |
| 745 | 836 | ||
| 746 | ;;;###autoload | 837 | ;;;###autoload |
| @@ -748,9 +839,11 @@ Default to the URL around or before point." | |||
| 748 | ;; new-window ignored | 839 | ;; new-window ignored |
| 749 | "Ask the Lynx WWW browser to load URL. | 840 | "Ask the Lynx WWW browser to load URL. |
| 750 | Default to the URL around or before point. A new Lynx process is run | 841 | Default to the URL around or before point. A new Lynx process is run |
| 751 | in an Xterm window." | 842 | in an Xterm window using the Xterm program named by `browse-url-xterm-program' |
| 843 | with possible additional arguments `browse-url-xterm-args'." | ||
| 752 | (interactive (browse-url-interactive-arg "Lynx URL: ")) | 844 | (interactive (browse-url-interactive-arg "Lynx URL: ")) |
| 753 | (start-process (concat "lynx" url) nil "xterm" "-e" "lynx" url)) | 845 | (apply 'start-process (concat "lynx" url) nil browse-url-xterm-program |
| 846 | (append browse-url-xterm-args (list "-e" "lynx" url)))) | ||
| 754 | 847 | ||
| 755 | ;; --- Lynx in an Emacs "term" window --- | 848 | ;; --- Lynx in an Emacs "term" window --- |
| 756 | 849 | ||
| @@ -770,6 +863,57 @@ an Emacs buffer." | |||
| 770 | (switch-to-buffer "*browse-url*")) | 863 | (switch-to-buffer "*browse-url*")) |
| 771 | (terminal-emulator "*browse-url*" "lynx" (list url))))) | 864 | (terminal-emulator "*browse-url*" "lynx" (list url))))) |
| 772 | 865 | ||
| 866 | ;; --- MMM --- | ||
| 867 | |||
| 868 | ;;;###autoload | ||
| 869 | (defun browse-url-mmm (url &optional new-window) | ||
| 870 | "Ask the MMM WWW browser to load URL. | ||
| 871 | Default to the URL around or before point." | ||
| 872 | (interactive (browse-url-interactive-arg "MMM URL: ")) | ||
| 873 | (message "Sending URL to MMM...") | ||
| 874 | (save-excursion | ||
| 875 | (set-buffer (get-buffer-create " *Shell Command Output*")) | ||
| 876 | (erase-buffer) | ||
| 877 | ;; mmm_remote just SEGVs if the file isn't there... | ||
| 878 | (if (or (file-exists-p (expand-file-name "~/.mmm_remote")) | ||
| 879 | ;; location in v 0.4: | ||
| 880 | (file-exists-p (expand-file-name "~/.mmm/remote"))) | ||
| 881 | (call-process "mmm_remote" nil 0 nil url) | ||
| 882 | (call-process "mmm" nil 0 nil "-external" url)) | ||
| 883 | (message "Sending URL to MMM... done"))) | ||
| 884 | |||
| 885 | ;; --- mailto --- | ||
| 886 | |||
| 887 | ;;;###autoload | ||
| 888 | (defun browse-url-mail (url) | ||
| 889 | "Open a new mail message buffer within Emacs. | ||
| 890 | Default to the mailto URL around or before point." | ||
| 891 | (interactive (browse-url-interactive-arg "Mailto URL: ")) | ||
| 892 | (save-excursion | ||
| 893 | ;; open mail buffer, specifying TO and REPLYBUFFER | ||
| 894 | (mail nil (if (string-match "^mailto:" url) | ||
| 895 | (substring url 7) | ||
| 896 | url) | ||
| 897 | nil nil nil | ||
| 898 | (current-buffer)))) | ||
| 899 | |||
| 900 | ;; --- Random browser --- | ||
| 901 | |||
| 902 | ;;;###autoload | ||
| 903 | (defun browse-url-generic (url &optional new-window) | ||
| 904 | ;; new-window ignored | ||
| 905 | "Ask the WWW browser defined by `browse-url-generic-program' to load URL. | ||
| 906 | Default to the URL around or before point. A fresh copy of the | ||
| 907 | browser is started up in a new process with possible additional arguments | ||
| 908 | `browse-url-generic-args'. This is appropriate for browsers which | ||
| 909 | don't offer a form of remote control." | ||
| 910 | (interactive (browse-url-interactive-arg "URL: ")) | ||
| 911 | (if (not browse-url-generic-program) | ||
| 912 | (error "No browser defined (`browse-url-generic-program')")) | ||
| 913 | (apply 'start-process (concat browse-url-generic-program url) nil | ||
| 914 | browse-url-generic-program | ||
| 915 | (append browse-url-generic-args (list url)))) | ||
| 916 | |||
| 773 | (provide 'browse-url) | 917 | (provide 'browse-url) |
| 774 | 918 | ||
| 775 | ;;; browse-url.el ends here | 919 | ;;; browse-url.el ends here |