;;; browse-url.el --- pass a URL to a WWW browser
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;; Author: Denis Howe <dbh@doc.ic.ac.uk>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; browse-url-cci XMosaic 2.5
;; browse-url-w3 w3 0
;; browse-url-w3-gnudoit w3 remotely
-;; browse-url-lynx-* Lynx 0
+;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
;; browse-url-default-windows-browser MS-Windows browser
;; browse-url-default-macosx-browser Mac OS X browser
(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 "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 "Text browser in an xterm window"
+ :value browse-url-text-xterm)
+ (function-item :tag "Text browser in an Emacs window"
+ :value browse-url-text-emacs)
(function-item :tag "KDE" :value browse-url-kde)
(function-item :tag "Elinks" :value browse-url-elinks)
(function-item :tag "Specified by `Browse Url Generic Program'"
:group 'browse-url)
;;;###autoload
-(defcustom browse-url-firefox-program "firefox"
+(defcustom browse-url-firefox-program (purecopy "firefox")
"The name by which to invoke Firefox."
:type 'string
:group 'browse-url)
:group 'browse-url)
;;;###autoload
-(defcustom browse-url-galeon-program "galeon"
+(defcustom browse-url-galeon-program (purecopy "galeon")
"The name by which to invoke Galeon."
:type 'string
:group 'browse-url)
;; applies.
("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/")
,@(if (memq system-type '(windows-nt ms-dos cygwin))
- '(("^\\([a-zA-Z]:\\)[\\/]" . "file:\\1/")
+ '(("^\\([a-zA-Z]:\\)[\\/]" . "file:///\\1/")
("^[\\/][\\/]+" . "file://")))
- ("^/+" . "file:/"))
+ ("^/+" . "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 using `replace-match', not treating STRING
:type '(repeat (cons :format "%v"
(regexp :tag "Regexp")
(string :tag "Replacement")))
- :version "20.3"
+ :version "23.1"
:group 'browse-url)
(defcustom browse-url-save-file nil
(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-text-xterm'.
This might, for instance, be a separate color 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'."
:type 'string
:type 'number
:group 'browse-url)
-(defcustom browse-url-lynx-input-field 'avoid
- "Action on selecting an existing Lynx buffer at an input field.
-What to do when sending a new URL to an existing Lynx buffer in Emacs
-if the Lynx cursor is on an input field (in which case the `g' command
+(defcustom browse-url-text-browser "lynx"
+ "The name of the text browser to invoke."
+ :type 'string
+ :group 'browse-url
+ :version "23.1")
+
+(defcustom browse-url-text-emacs-args (and (not window-system)
+ '("-show_cursor"))
+ "A list of strings defining options for a text browser 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 "23.1"
+ :group 'browse-url)
+
+(defcustom browse-url-text-input-field 'avoid
+ "Action on selecting an existing text browser buffer at an input field.
+What to do when sending a new URL to an existing text browser buffer in Emacs
+if the browser cursor is on an input field (in which case the `g' command
would be entered as data). Such fields are recognized by the
-underlines ____. Allowed values: nil: disregard it, 'warn: warn the
-user and don't emit the URL, 'avoid: try to avoid the field by moving
+underlines ____. Allowed values: nil: disregard it, `warn': warn the
+user and don't emit the URL, `avoid': try to avoid the field by moving
down (this *won't* always work)."
: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"
+ :version "23.1"
: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."
+(defcustom browse-url-text-input-attempts 10
+ "How many times to try to move down from a series of text browser input fields."
:type 'integer
+ :version "23.1"
: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."
+(defcustom browse-url-text-input-delay 0.2
+ "Seconds to wait for a text browser between moves down from an input field."
:type 'number
+ :version "23.1"
:group 'browse-url)
(defcustom browse-url-kde-program "kfmclient"
(defun browse-url-url-encode-chars (text chars)
"URL-encode the chars in TEXT that match CHARS.
-CHARS is a regexp-like character alternative (e.g., \"[,)$]\")."
+CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
(let ((encoded-text (copy-sequence text))
(s 0))
(while (setq s (string-match chars encoded-text s))
(defun browse-url-encode-url (url)
"Escape annoying characters in URL.
-The annoying characters are those that can mislead a webbrowser
-regarding its parameter treatment. For instance, `,' can
-be misleading because it could be used to separate URLs."
- (browse-url-url-encode-chars url "[,)$]"))
+The annoying characters are those that can mislead a web browser
+regarding its parameter treatment."
+ ;; FIXME: Is there an actual example of a web browser getting
+ ;; confused? (This used to encode commas, but at least Firefox
+ ;; handles commas correctly and doesn't accept encoded commas.)
+ (browse-url-url-encode-chars url "[)$]"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input
;; this macro. We use that rather than interactive-p because
;; use in a keyboard macro should not change this behavior.
(defmacro browse-url-maybe-new-window (arg)
- `(if (or noninteractive (not (called-interactively-p)))
+ `(if (or noninteractive (not (called-interactively-p 'any)))
,arg
browse-url-new-window-flag))
(defun browse-url-file-url (file)
"Return the URL corresponding to FILE.
Use variable `browse-url-filename-alist' to map filenames to URLs."
- (let ((coding (and default-enable-multibyte-characters
+ ;; De-munge Cygwin filenames before passing them to Windows browser.
+ (if (eq system-type 'cygwin)
+ (let ((winfile (with-output-to-string
+ (call-process "cygpath" nil standard-output
+ nil "-m" file))))
+ (setq file (substring winfile 0 -1))))
+ (let ((coding (and (default-value 'enable-multibyte-characters)
(or file-name-coding-system
default-file-name-coding-system))))
(if coding (setq file (encode-coding-string file coding))))
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: "))
- (unless (interactive-p)
+ (unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
(let ((process-environment (copy-sequence process-environment)))
;; When connected to various displays, be careful to use the display of
;; which may not even exist any more.
(if (stringp (frame-parameter (selected-frame) 'display))
(setenv "DISPLAY" (frame-parameter (selected-frame) 'display)))
- (if (functionp browse-url-browser-function)
- (apply browse-url-browser-function url args)
- ;; The `function' can be an alist; look down it for first match
- ;; and apply the function (which might be a lambda).
- (catch 'done
- (dolist (bf browse-url-browser-function)
- (when (string-match (car bf) url)
- (apply (cdr bf) url args)
- (throw 'done t)))
- (error "No browse-url-browser-function matching URL %s"
- url)))))
+ (if (and (consp browse-url-browser-function)
+ (not (functionp browse-url-browser-function)))
+ ;; The `function' can be an alist; look down it for first match
+ ;; and apply the function (which might be a lambda).
+ (catch 'done
+ (dolist (bf browse-url-browser-function)
+ (when (string-match (car bf) url)
+ (apply (cdr bf) url args)
+ (throw 'done t)))
+ (error "No browse-url-browser-function matching URL %s"
+ url))
+ ;; Unbound symbols go down this leg, since void-function from
+ ;; apply is clearer than wrong-type-argument from dolist.
+ (apply browse-url-browser-function url args))))
;;;###autoload
(defun browse-url-at-point (&optional arg)
;; --- Default MS-Windows browser ---
(defvar dos-windows-version)
+(declare-function w32-shell-execute "w32fns.c") ;; Defined in C.
(defun browse-url-default-windows-browser (url &optional new-window)
(interactive (browse-url-interactive-arg "URL: "))
- (if (eq system-type 'ms-dos)
- (if dos-windows-version
- (shell-command (concat "start " (shell-quote-argument url)))
- (error "Browsing URLs is not supported on this system"))
- (w32-shell-execute "open" url)))
+ (cond ((eq system-type 'ms-dos)
+ (if dos-windows-version
+ (shell-command (concat "start " (shell-quote-argument url)))
+ (error "Browsing URLs is not supported on this system")))
+ ((eq system-type 'cygwin)
+ (call-process "cygstart" nil nil nil url))
+ (t (w32-shell-execute "open" url))))
(defun browse-url-default-macosx-browser (url &optional new-window)
(interactive (browse-url-interactive-arg "URL: "))
((executable-find browse-url-kde-program) 'browse-url-kde)
((executable-find browse-url-netscape-program) 'browse-url-netscape)
((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
- ((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm)
+ ((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
(t
- (lambda (&ignore args) (error "No usable browser found"))))
+ (lambda (&rest ignore) (error "No usable browser found"))))
url args))
;;;###autoload
browse-url-epiphany-program
(append browse-url-epiphany-startup-arguments (list url))))))
+(defvar url-handler-regexp)
+
;;;###autoload
(defun browse-url-emacs (url &optional new-window)
"Ask Emacs to load URL into a buffer and show it in another window."
;; --- W3 ---
+;; External.
+(declare-function w3-fetch-other-window "ext:w3m" (&optional url))
+(declare-function w3-fetch "ext:w3m" (&optional url target))
+
;;;###autoload
(defun browse-url-w3 (url &optional new-window)
"Ask the w3 WWW browser to load URL.
;; --- Lynx in an xterm ---
;;;###autoload
-(defun browse-url-lynx-xterm (url &optional new-window)
+(defun browse-url-text-xterm (url &optional new-window)
;; new-window ignored
- "Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point. A new Lynx process is run
+ "Ask a text browser to load URL.
+URL defaults to the URL around or before point.
+This runs the text browser specified by `browse-url-text-browser'.
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
- ,@browse-url-xterm-args "-e" "lynx"
+ (interactive (browse-url-interactive-arg "Text browser URL: "))
+ (apply #'start-process `(,(concat browse-url-text-browser url)
+ nil ,browse-url-xterm-program
+ ,@browse-url-xterm-args "-e" ,browse-url-text-browser
,url)))
;; --- Lynx in an Emacs "term" window ---
;;;###autoload
-(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.
+(defun browse-url-text-emacs (url &optional new-buffer)
+ "Ask a text browser to load URL.
+URL defaults to the URL around or before point.
+This runs the text browser specified by `browse-url-text-browser'.
+With a prefix argument, it runs a new browser process in a new buffer.
When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new lynx in a new term window,
+non-nil, load the document in a new browser process in a new term window,
otherwise use any existing one. A non-nil interactive prefix argument
reverses the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
- (interactive (browse-url-interactive-arg "Lynx URL: "))
+ (interactive (browse-url-interactive-arg "Text browser URL: "))
(let* ((system-uses-terminfo t) ; Lynx uses terminfo
;; (term-term-name "vt100") ; ??
- (buf (get-buffer "*lynx*"))
+ (buf (get-buffer "*text browser*"))
(proc (and buf (get-buffer-process buf)))
- (n browse-url-lynx-input-attempts))
+ (n browse-url-text-input-attempts))
(if (and (browse-url-maybe-new-window new-buffer) buf)
;; Rename away the OLD buffer. This isn't very polite, but
;; term insists on working in a buffer named *lynx* and would
(not buf)
(not proc)
(not (memq (process-status proc) '(run stop))))
- ;; start a new lynx
+ ;; start a new text browser
(progn
(setq buf
(apply #'make-term
- `("lynx" "lynx" nil ,@browse-url-lynx-emacs-args
+ `(,browse-url-text-browser
+ ,browse-url-text-browser
+ nil ,@browse-url-text-emacs-args
,url)))
(switch-to-buffer buf)
(term-char-mode)
(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
+ ;; Send the url to the text browser in the old buffer
(let ((win (get-buffer-window buf t)))
(if win
(select-window win)
(switch-to-buffer buf)))
(if (eq (following-char) ?_)
- (cond ((eq browse-url-lynx-input-field 'warn)
+ (cond ((eq browse-url-text-input-field 'warn)
(error "Please move out of the input field first"))
- ((eq browse-url-lynx-input-field 'avoid)
+ ((eq browse-url-text-input-field 'avoid)
(while (and (eq (following-char) ?_) (> n 0))
(term-send-down) ; down arrow
- (sit-for browse-url-lynx-input-delay))
+ (sit-for browse-url-text-input-delay))
(if (eq (following-char) ?_)
(error "Cannot move out of the input field, sorry")))))
(term-send-string proc (concat "g" ; goto
(defun browse-url-elinks-new-window (url)
"Ask the Elinks WWW browser to load URL in a new window."
- (let ((process-environment (browse-url-process-environment)))
+ (let ((process-environment (browse-url-process-environment)))
(apply #'start-process
(append (list (concat "elinks:" url)
nil)