;;; browse-url.el --- Pass a URL to a WWW browser
-;; Copyright 1995, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
;; Author: Denis Howe <dbh@doc.ic.ac.uk>
-;; Maintainer: Dave Love <d.love@dl.ac.uk>
+;; Maintainer: Dave Love <fx@gnu.org>
;; Created: 03 Apr 1995
;; Keywords: hypertext, hypermedia, mouse
;;; 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
;; is started. Currently there is support for:
;; Function Browser Earliest version
-;; browse-url-netscape Netscape 1.1b1
+;; browse-url-netscape Netscape 1.1b1
;; browse-url-mosaic XMosaic/mMosaic <= 2.4
;; browse-url-cci XMosaic 2.5
;; browse-url-w3 w3 0
;; doesn't let you edit the URL like browse-url.
;; The `gnuserv' package that can be used to control it in another
;; Emacs process is available from
-;; <URL:http://hplbwww.hpl.hp.com/people/ange/gnuserv/>.
+;; <URL:ftp://ftp.splode.com/pub/users/friedman/packages/>.
;; Grail is the freely available WWW browser implemented in Python, a
;; cool object-oriented freely available interpreted language. Grail
;; Python see <url:http://www.python.org/>. Grail support in
;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>.
-;; MMM is the freely available WWW browser implemented in Caml Special
-;; Light, a cool impure functional programming language, by Francois
+;; MMM is the freely available WWW browser implemented in Objective
+;; Caml, a cool impure functional programming language, by Francois
;; Rouaix. See the MMM home page
;; <URL:http://pauillac.inria.fr/%7Erouaix/mmm/>.
;; with this.
;; 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.
+;; Andreessen's html-mode (LCD modes/html-mode.el.Z). See also the
+;; ffap.el package. The huge hyperbole package also contains similar
+;; functions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Help!
;; (global-set-key "\C-c\C-zu" 'browse-url)
;; (global-set-key "\C-c\C-zv" 'browse-url-of-file)
;; (add-hook 'dired-mode-hook
-;; (function (lambda ()
-;; (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file))))
+;; (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))))
+;; (add-hook 'rmail-mode-hook (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"
;; (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 ()
+;; (lambda ()
;; (add-hook 'local-write-file-hooks
-;; (function (lambda ()
+;; (lambda ()
;; (let ((local-write-file-hooks))
;; (save-buffer))
;; (browse-url-netscape-reload)
-;; t)) ; => file written by hook
-;; t)))) ; append to l-w-f-hooks
+;; t) ; => file written by hook
+;; t))) ; append to l-w-f-hooks
;;
;; OR have browse-url-of-file ask Netscape to load and then reload the
;; file:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
-(eval-when-compile (require 'dired)
- (require 'thingatpt))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
+(eval-when-compile (require 'dired)
+ (require 'thingatpt)
+ (require 'term))
+
(defgroup browse-url nil
"Use a web browser to look at a URL."
:prefix "browse-url-"
`browse-url-of-file' commands.
If the value is not a function it should be a list of pairs
-(REGEXP.FUNCTION). In this case the function called will be the one
+(REGEXP . FUNCTION). In this case the function called will be the one
associated with the first REGEXP which matches the current URL. The
function is passed the URL and any other args of `browse-url'. The last
regexp should probably be \".\" to specify a default browser."
- :type 'function
+ :type '(choice
+ (function-item :tag "Emacs W3" :value browse-url-w3)
+ (function-item :tag "W3 in another Emacs via `gnudoit'"
+ :value browse-url-w3-gnudoit)
+ (function-item :tag "Netscape" :value browse-url-netscape)
+ (function-item :tag "Mosaic" :value browse-url-mosaic)
+ (function-item :tag "Mosaic using CCI" :value browse-url-cci)
+ (function-item :tag "IXI Mosaic" :value browse-url-iximosaic)
+ (function-item :tag "Lynx in an xterm window"
+ :value browse-url-lynx-xterm)
+ (function-item :tag "Lynx in an Emacs window"
+ :value browse-url-lynx-emacs)
+ (function-item :tag "Grail" :value browse-url-grail)
+ (function-item :tag "MMM" :value browse-url-mmm)
+ (function-item :tag "Specified by `Browse Url Generic Program'"
+ :value browse-url-generic)
+ (function :tag "Your own function"))
:group 'browse-url)
(defcustom browse-url-netscape-program "netscape"
- "*The name by which to invoke Netscape."
+ ;; Info about netscape-remote from Kurt Swanson in gnu.emacs.gnus
+ "The name by which to invoke Netscape.
+
+It is said that source is available for a program `netscape-remote'
+which starts up very much quicker than `netscape' and that it is
+useful to set this variable to the name of a script which invokes that
+program like:
+ #!/bin/sh
+ /usr/local/bin/netscape-remote \"$@\" > /dev/null 2>&1
+"
:type 'string
:group 'browse-url)
(defcustom browse-url-netscape-arguments nil
- "*A list of strings to pass to Netscape as arguments."
+ "A list of strings to pass to Netscape as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
- "*A list of strings to pass to Netscape when it start up.
+ "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."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+;;;###autoload
(defcustom browse-url-new-window-p nil
- "*If non-nil, always open a new browser window.
-Passing an interactive argument to \\[browse-url-netscape],
-\\[browse-url-mosaic] or \\[browse-url-cci] reverses the effect of
-this variable. Requires Netscape version 1.1N or later or XMosaic
-version 2.5 or later."
+ "*If non-nil, always open a new browser window with appropriate browsers.
+Passing an interactive argument to \\[browse-url], or specific browser
+commands reverses the effect of this variable. Requires Netscape version
+1.1N or later or XMosaic version 2.5 or later if using those browsers."
:type 'boolean
:group 'browse-url)
+;;;###autoload
(defcustom browse-url-netscape-display nil
"*The X display for running Netscape, if not same as Emacs'."
- :type '(choice string (const nil))
+ :type '(choice string (const :tag "Default" nil))
:group 'browse-url)
(defcustom browse-url-mosaic-program "xmosaic"
- "*The name by which to invoke Mosaic (or mMosaic)."
+ "The name by which to invoke Mosaic (or mMosaic)."
:type 'string
+ :version "20.3"
:group 'browse-url)
(defcustom browse-url-mosaic-arguments nil
- "*A list of strings to pass to Mosaic as arguments."
+ "A list of strings to pass to Mosaic as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
-(defvar browse-url-path-regexp
- "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+"
- "A regular expression to match 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''.")
-
-(defvar browse-url-regexp
- (concat
- "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
- browse-url-path-regexp)
- "A regular expression probably matching a complete URL.")
-
-(defvar browse-url-markedup-regexp
- "<URL:[^>]+>"
- "A regular expression matching a URL marked up per RFC1738.
-This may be broken across lines.")
-
(defcustom browse-url-filename-alist
- '(("^/+" . "file:/"))
- "*An alist of (REGEXP . STRING) pairs.
+ '(("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/")
+ ;; The above loses the username to avoid the browser prompting for
+ ;; it in anonymous cases. If it's not anonymous the next regexp
+ ;; applies.
+ ("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/")
+ ("^/+" . "file:/"))
+ "An alist of (REGEXP . STRING) pairs used by `browse-url-of-file'.
Any substring of a filename matching one of the REGEXPs is replaced by
-the corresponding STRING. All pairs are applied in the order given.
-The default value prepends `file:' to any path beginning with `/'.
-Used by the `browse-url-of-file' command.
+the corresponding STRING using `replace-match', not treating STRING
+literally. All pairs are applied in the order given. The default
+value converts ange-ftp/EFS-style paths into ftp URLs and prepends
+`file:' to any path beginning with `/'.
-For example, to map EFS filenames to URLs:
+For example, adding to the default a specific translation of an ange-ftp
+address to an HTTP URL:
(setq browse-url-filename-alist
'((\"/webmaster@webserver:/home/www/html/\" .
\"http://www.acme.co.uk/\")
+ (\"^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*\" . \"ftp://\\2/\")
+ (\"^/\\([^:@]+@\\)?\\([^:]+\\):/*\" . \"ftp://\\1\\2/\")
(\"^/+\" . \"file:/\")))
"
:type '(repeat (cons :format "%v"
- (string :tag "Regexp")
+ (regexp :tag "Regexp")
(string :tag "Replacement")))
+ :version "20.3"
:group 'browse-url)
+;;;###autoload
(defcustom browse-url-save-file nil
"*If non-nil, save the buffer before displaying its file.
Used by the `browse-url-of-file' command."
:group 'browse-url)
(defcustom browse-url-of-file-hook nil
- "*Run after `browse-url-of-file' has asked a browser to load a file.
+ "Run 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."
:type 'hook
+ :options '(browse-url-netscape-reload)
:group 'browse-url)
(defvar browse-url-usr1-signal
which is 30 on SunOS and 16 on HP-UX and Solaris.")
(defcustom browse-url-CCI-port 3003
- "*Port to access XMosaic via CCI.
+ "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."
:type 'integer
(make-variable-buffer-local 'browse-url-temp-file-name)
(defcustom browse-url-xterm-program "xterm"
- "*The name of the terminal emulator used by `browse-url-lynx-xterm'.
+ "The name of the terminal emulator used by `browse-url-lynx-xterm'.
This might, for instance, be a separate colour version of xterm."
:type 'string
:group 'browse-url)
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(defcustom browse-url-lynx-emacs-args (and (not window-system)
+ '("-show_cursor"))
+ "A list of strings defining options for Lynx in an Emacs buffer.
+
+The default is none in a window system, otherwise `-show_cursor' to
+indicate the position of the current link in the absence of
+highlighting, assuming the normal default for showing the cursor."
+ :type '(repeat (string :tag "Argument"))
+ :version "20.3"
+ :group 'browse-url)
+
(defcustom browse-url-gnudoit-program "gnudoit"
- "*The name of the `gnudoit' program used by `browse-url-w3-gnudoit'."
+ "The name of the `gnudoit' program used by `browse-url-w3-gnudoit'."
:type 'string
:group 'browse-url)
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+;;;###autoload
(defcustom browse-url-generic-program nil
"*The name of the browser program used by `browse-url-generic'."
- :type '(choice string (const nil))
+ :type '(choice string (const :tag "None" nil))
:group 'browse-url)
(defcustom browse-url-generic-args nil
(defcustom browse-url-temp-dir
(or (getenv "TMPDIR") "/tmp")
- "*The name of a directory for browse-url's temporary files.
+ "The name of a directory for browse-url's temporary files.
Such files are generated by functions like `browse-url-of-region'.
You might want to set this to somewhere with restricted read permissions
for privacy's sake."
(defcustom browse-url-netscape-version
3
- "*The version of Netscape you are using.
+ "The version of Netscape you are using.
This affects how URL reloading is done; the mechanism changed
incompatibly at version 4."
:type 'number
:type '(choice (const :tag "Move to try to avoid field" :value avoid)
(const :tag "Disregard" :value nil)
(const :tag "Warn, don't emit URL" :value warn))
+ :version "20.3"
:group 'browse-url)
(defcustom browse-url-lynx-input-attempts 10
"*How many times to try to move down from a series of lynx input fields."
+ :version "20.3"
:type 'integer
:group 'browse-url)
(defcustom browse-url-lynx-input-delay 0.2
- "*How many seconds to wait for lynx between moves down from an input field."
+ "How many seconds to wait for lynx between moves down from an input field."
+ :version "20.3"
:type 'number
:group 'browse-url)
(defun browse-url-file-url (file)
"Return the URL corresponding to FILE.
-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."
+Use variable `browse-url-filename-alist' to map filenames to URLs."
;; URL-encode special chars, do % first
(let ((s 0))
(while (setq s (string-match "%" file s))
(to-string (cdr map)))
(setq maps (cdr maps))
(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)))))
+ (setq file (replace-match to-string t nil file))))))
file)
;;;###autoload
(interactive "r")
(save-excursion
(save-restriction
- (narrow-to-region (mark) (point))
+ (narrow-to-region min max)
(browse-url-of-buffer))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A generic command to call the current browse-url-browser-function
;;;###autoload
-(defun browse-url (&rest args)
+(defun browse-url (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: "))
- (if (consp browse-url-browser-function)
- (apply 'browse-url-choose-browser args)
- (apply browse-url-browser-function args)))
-
-(defun browse-url-choose-browser (url &rest args)
- "Pass URL to a browser function chosen.
-This is done according to the association list in variable
-`browse-url-browser-function'."
- (let ((blist browse-url-browser-function)
- re bf)
- (while (consp blist)
- (setq re (car (car blist))
- bf (cdr (car blist))
- blist (cdr blist))
- (if (string-match re url)
- (progn (apply bf url args) (setq blist t))))
- (or blist
- (error "No browser in browse-url-browser-function matching URL %s" url))))
+ (let ((bf browse-url-browser-function) re)
+ (while (consp bf)
+ (setq re (car (car bf))
+ bf (if (string-match re url)
+ (cdr (car bf)) ; The function
+ (cdr bf)))) ; More pairs
+ (or bf (error "No browser in browse-url-browser-function matching URL %s"
+ url))
+ (apply bf url args)))
;;;###autoload
(defun browse-url-at-point ()
"Return the X display Emacs is running on.
This is nil if the display is the same as the DISPLAY environment variable.
-Actually Emacs could be using several screens on several displays, as
-listed by (emacs-display-list) and (x-display-screens DISPLAY), this
-just returns the display showing the selected frame. You got a
-problem with that?"
- (let (device display)
- (and (fboundp 'selected-device) (fboundp 'device-type) (fboundp 'device-connection)
- (setq device (selected-device))
- (eq (device-type device) 'x)
- (setq display (device-connection device))
- (not (equal display (getenv "DISPLAY")))
- display)))
+Actually Emacs could be using several displays; this just returns the
+one showing the selected frame."
+ (let ((display (cdr-safe (assq 'display (frame-parameters)))))
+ (and (not (equal display (getenv "DISPLAY")))
+ display)))
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
(if (eq window-system 'w32)
(list url)
(if new-window '("-noraise"))
- (list "-remote"
- (concat "openURL(" url
+ (list "-remote"
+ (concat "openURL(" url
(if (browse-url-maybe-new-window
new-window)
",new-window")
;;;###autoload
(defvar browse-url-grail
(concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py")
- "*Location of Grail remote control client script `rcgrail.py'.
+ "Location of Grail remote control client script `rcgrail.py'.
Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
;;;###autoload
;;;###autoload
(defun browse-url-w3 (url &optional new-window)
- ;; new-window ignored
"Ask the w3 WWW browser to load URL.
-Default to the URL around or before point."
+Default to the URL around or before point.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil, load the document in a new window. 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'."
(interactive (browse-url-interactive-arg "W3 URL: "))
(if (browse-url-maybe-new-window new-window)
(w3-fetch-other-window)
in an Xterm window using the Xterm program named by `browse-url-xterm-program'
with possible additional arguments `browse-url-xterm-args'."
(interactive (browse-url-interactive-arg "Lynx URL: "))
- (apply 'start-process (concat "lynx" url) nil browse-url-xterm-program
- (append browse-url-xterm-args (list "-e" "lynx" url))))
+ (apply #'start-process `(,(concat "lynx" url) nil ,browse-url-xterm-program
+ ,@browse-url-xterm-args "-e" "lynx" ,url)))
;; --- Lynx in an Emacs "term" window ---
(defun browse-url-lynx-emacs (url &optional new-buffer)
"Ask the Lynx WWW browser to load URL.
Default to the URL around or before point. With a prefix argument, run
-a new Lynx process in a new buffer."
+a new Lynx process in a new buffer.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil, load the document in a new lynx in a new term window,
+otherwise use any 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'."
(interactive (browse-url-interactive-arg "Lynx URL: "))
(let* ((system-uses-terminfo t) ; Lynx uses terminfo
;; (term-term-name "vt100") ; ??
(not proc)
(not (memq (process-status proc) '(run stop))))
;; start a new lynx
- (progn (switch-to-buffer (make-term "lynx" "lynx" nil url))
- (term-char-mode))
+ (progn
+ (setq buf
+ (apply #'make-term
+ `("lynx" "lynx" nil ,@browse-url-lynx-emacs-args ,url)))
+ (switch-to-buffer buf)
+ (term-char-mode)
+ (set-process-sentinel
+ (get-buffer-process buf)
+ ;; Don't leave around a dead one (especially because of its
+ ;; munged keymap.)
+ (lambda (process event)
+ (if (not (memq (process-status process) '(run stop)))
+ (let ((buf (process-buffer process)))
+ (if buf (kill-buffer buf)))))))
;; send the url to lynx in the old buffer
(let ((win (get-buffer-window buf t)))
(if win
Default to using the mailto: URL around or before point as the
recipient's address. Supplying a non-nil interactive prefix argument
will cause the mail to be composed in another window rather than the
-current one."
+current one.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil use `compose-mail-other-window', otherwise `compose-mail'. 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'."
(interactive (browse-url-interactive-arg "Mailto URL: "))
(save-excursion
(let ((func (if (browse-url-maybe-new-window new-window)
HCoop / bpt / emacs.git / blobdiff