X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/771f48f0638f4832c882b2eab1bbc11e36ed5cf5..49f70d46ea38ceb7a501594db7f6ea35e19681aa:/lisp/net/browse-url.el?ds=sidebyside diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 523588ec7c..a57755b22e 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -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 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. ;; Author: Denis Howe ;; Maintainer: FSF @@ -10,10 +10,10 @@ ;; 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 . ;;; 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) @@ -825,14 +834,17 @@ to use." ;; --- 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: ")) @@ -887,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 @@ -1283,6 +1295,10 @@ used instead of `browse-url-new-window-flag'." ;; --- 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. @@ -1319,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 --- @@ -1334,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. @@ -1466,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)