]> code.delx.au - gnu-emacs/blobdiff - lisp/net/browse-url.el
Add 2010 to copyright years.
[gnu-emacs] / lisp / net / browse-url.el
index f5ff75774e26b7e06b1f92be529f8961f0a7ef1e..3a5fa8c30a682a2b1c1c601577c543d8fc39eaf7 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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.
+;;   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
@@ -21,9 +21,7 @@
 ;; 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:
 
@@ -315,7 +313,7 @@ Defaults to the value of `browse-url-mozilla-arguments' at the time
   :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)
@@ -333,7 +331,7 @@ Defaults to the value of `browse-url-firefox-arguments' at the time
   :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)
@@ -446,9 +444,9 @@ commands reverses the effect of this variable.  Requires Netscape version
     ;; 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
@@ -468,7 +466,7 @@ address to an HTTP URL:
   :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
@@ -502,7 +500,7 @@ enabled.  The port number should be set in `browse-url-CCI-port'."
 
 (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."
@@ -615,7 +613,7 @@ down (this *won't* always work)."
 
 (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))
@@ -628,10 +626,12 @@ CHARS is a regexp-like character alternative (e.g., \"[,)$]\")."
 
 (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
@@ -671,7 +671,7 @@ for use in `interactive'."
 ;; 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))
 
@@ -701,7 +701,13 @@ interactively.  Turn the filename into a URL with function
 (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))))
@@ -772,7 +778,7 @@ narrowed."
 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
@@ -780,17 +786,20 @@ Prompts for a URL, defaulting to the URL at or before point.  Variable
     ;; 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)
@@ -829,11 +838,13 @@ to use."
 
 (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: "))
@@ -888,7 +899,7 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
     ((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
@@ -1324,14 +1335,14 @@ The `browse-url-gnudoit-program' program is used with options given by
 (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 ---
@@ -1339,7 +1350,7 @@ with possible additional arguments `browse-url-xterm-args'."
 ;;;###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.
 
@@ -1471,7 +1482,7 @@ Default to the URL around or before point."
 
 (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)