;;; 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, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; 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:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables
-(eval-when-compile (require 'cl)
- (require 'thingatpt)
- (require 'term)
- (require 'dired)
- (require 'executable)
- (require 'w3-auto nil t))
+(eval-when-compile (require 'cl))
(defgroup browse-url nil
"Use a web browser to look at a URL."
:prefix "browse-url-"
:link '(emacs-commentary-link "browse-url")
- :group 'hypermedia)
+ :group 'external
+ :group 'comm)
;;;###autoload
(defcustom browse-url-browser-function
(cond
((memq system-type '(windows-nt ms-dos cygwin))
'browse-url-default-windows-browser)
- ((memq system-type '(darwin)) 'browse-url-default-macosx-browser)
- (t 'browse-url-default-browser))
+ ((memq system-type '(darwin))
+ 'browse-url-default-macosx-browser)
+ (t
+ 'browse-url-default-browser))
"Function to display the current buffer in a WWW browser.
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
(function :tag "Your own function")
(alist :tag "Regexp/function association list"
:key-type regexp :value-type function))
- :version "21.1"
+ :version "24.1"
+ :group 'browse-url)
+
+(defcustom browse-url-mailto-function 'browse-url-mail
+ "Function to display mailto: links.
+This variable uses the same syntax as the
+`browse-url-browser-function' variable. If the
+`browse-url-mailto-function' variable is nil, that variable will
+be used instead."
+ :type '(choice
+ (function-item :tag "Emacs Mail" :value browse-url-mail)
+ (function-item :tag "None" nil))
+ :version "24.1"
:group 'browse-url)
(defcustom browse-url-netscape-program "netscape"
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
-;;;###autoload
-(defcustom browse-url-firefox-program "firefox"
+(defcustom browse-url-firefox-program
+ (let ((candidates '("firefox" "iceweasel")))
+ (while (and candidates (not (executable-find (car candidates))))
+ (setq candidates (cdr candidates)))
+ (or (car candidates) "firefox"))
"The name by which to invoke Firefox."
:type 'string
:group 'browse-url)
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
-;;;###autoload
(defcustom browse-url-galeon-program "galeon"
"The name by which to invoke Galeon."
:type 'string
;; 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
(defvar browse-url-temp-file-name 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-text-xterm'.
This might, for instance, be a separate color version of xterm."
:group 'browse-url)
(defcustom browse-url-elinks-wrapper '("xterm" "-e")
- "*Wrapper command prepended to the Elinks command-line."
+ "Wrapper command prepended to the Elinks command-line."
:type '(repeat (string :tag "Wrapper"))
:group 'browse-url)
(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
-;;;###autoload
(defun browse-url-url-at-point ()
(let ((url (thing-at-point 'url)))
(set-text-properties 0 (length url) nil url)
;; 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))))
(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
+(declare-function dired-get-filename "dired"
+ (&optional localp no-error-if-not-filep))
+
;;;###autoload
(defun browse-url-of-dired-file ()
"In Dired, ask a WWW browser to display the file named on this line."
(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."
+`browse-url-browser-function' says which browser to use.
+If the URL is a mailto: URL, consult `browse-url-mailto-function'
+first, if that exists."
(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)))
+ (let ((process-environment (copy-sequence process-environment))
+ (function (or (and (string-match "\\`mailto:" url)
+ browse-url-mailto-function)
+ browse-url-browser-function)))
;; When connected to various displays, be careful to use the display of
;; the currently selected frame, rather than the original start display,
;; 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 function)
+ (not (functionp 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 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 function url args))))
;;;###autoload
(defun browse-url-at-point (&optional arg)
(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: "))
(and (not (equal display (getenv "DISPLAY")))
display)))
-;;;###autoload
(defun browse-url-default-browser (url &rest args)
"Find a suitable browser and ask it to load URL.
Default to the URL around or before point.
Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
(apply
(cond
+ ((browse-url-can-use-xdg-open) 'browse-url-xdg-open)
((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
((executable-find browse-url-firefox-program) 'browse-url-firefox)
((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))
+(defun browse-url-can-use-xdg-open ()
+ "Check if xdg-open can be used, i.e. we are on Gnome, KDE or xfce4."
+ (and (getenv "DISPLAY")
+ (executable-find "xdg-open")
+ ;; xdg-open may call gnome-open and that does not wait for its child
+ ;; to finish. This child may then be killed when the parent dies.
+ ;; Use nohup to work around.
+ (executable-find "nohup")
+ (or (getenv "GNOME_DESKTOP_SESSION_ID")
+ ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also.
+ (condition-case nil
+ (eq 0 (call-process
+ "dbus-send" nil nil nil
+ "--dest=org.gnome.SessionManager"
+ "--print-reply"
+ "/org/gnome/SessionManager"
+ "org.gnome.SessionManager.CanShutdown"))
+ (error nil))
+ (equal (getenv "KDE_FULL_SESSION") "true")
+ (condition-case nil
+ (eq 0 (call-process
+ "/bin/sh" nil nil nil
+ "-c"
+ "xprop -root _DT_SAVE_MODE|grep xfce4"))
+ (error nil)))))
+
+
+;;;###autoload
+(defun browse-url-xdg-open (url &optional new-window)
+ (interactive (browse-url-interactive-arg "URL: "))
+ (call-process "nohup" nil nil nil "xdg-open" url))
+
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
"Ask the Netscape WWW browser to load URL.
(defun browse-url-text-xterm (url &optional new-window)
;; new-window ignored
"Ask a text browser to load URL.
-URL defaults to the URL around or before point.
+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 "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
+ ,@browse-url-xterm-args "-e" ,browse-url-text-browser
,url)))
;; --- Lynx in an Emacs "term" window ---
+(declare-function term-char-mode "term" ())
+(declare-function term-send-down "term" ())
+(declare-function term-send-string "term" (proc str))
+
;;;###autoload
(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.
+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.
(buf (get-buffer "*text browser*"))
(proc (and buf (get-buffer-process buf)))
(n browse-url-text-input-attempts))
+ (require 'term)
(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
(to (assoc "To" alist))
(subject (assoc "Subject" alist))
(body (assoc "Body" alist))
- (rest (delete to (delete subject (delete body alist))))
+ (rest (delq to (delq subject (delq body alist))))
(to (cdr to))
(subject (cdr subject))
(body (cdr body))
(mail-citation-hook (unless body mail-citation-hook)))
(if (browse-url-maybe-new-window new-window)
(compose-mail-other-window to subject rest nil
- (if body
- (list 'insert body)
- (list 'insert-buffer (current-buffer))))
+ (list 'insert-buffer (current-buffer)))
(compose-mail to subject rest nil nil
- (if body
- (list 'insert body)
- (list 'insert-buffer (current-buffer))))))))
+ (list 'insert-buffer (current-buffer))))
+ (when body
+ (goto-char (point-min))
+ (unless (or (search-forward (concat "\n" mail-header-separator "\n")
+ nil 'move)
+ (bolp))
+ (insert "\n"))
+ (goto-char (prog1
+ (point)
+ (insert (replace-regexp-in-string "\r\n" "\n" body))
+ (unless (bolp)
+ (insert "\n"))))))))
;; --- Random browser ---
(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)
(provide 'browse-url)
-;; arch-tag: d2079573-5c06-4097-9598-f550fba19430
;;; browse-url.el ends here