X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e572025ff11352705a5145cf77cdf6227f36d4b4..f49d1f52b2e368ef67dcfececd426de958548f4e:/lisp/net/browse-url.el diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index ddfaa91d95..f2af67458a 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1,7 +1,8 @@ ;;; 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, 2009 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 ;; Maintainer: FSF @@ -204,26 +205,24 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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. @@ -263,7 +262,19 @@ regexp should probably be \".\" to specify a default browser." (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" @@ -312,8 +323,11 @@ Defaults to the value of `browse-url-mozilla-arguments' at the time :type '(repeat (string :tag "Argument")) :group 'browse-url) -;;;###autoload -(defcustom browse-url-firefox-program (purecopy "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) @@ -330,8 +344,7 @@ Defaults to the value of `browse-url-firefox-arguments' at the time :type '(repeat (string :tag "Argument")) :group 'browse-url) -;;;###autoload -(defcustom browse-url-galeon-program (purecopy "galeon") +(defcustom browse-url-galeon-program "galeon" "The name by which to invoke Galeon." :type 'string :group 'browse-url) @@ -444,7 +457,7 @@ 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:///")) "An alist of (REGEXP . STRING) pairs used by `browse-url-of-file'. @@ -604,7 +617,7 @@ down (this *won't* always work)." :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) @@ -613,7 +626,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)) @@ -626,15 +639,16 @@ 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 -;;;###autoload (defun browse-url-url-at-point () (let ((url (thing-at-point 'url))) (set-text-properties 0 (length url) nil url) @@ -699,6 +713,12 @@ 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." + ;; 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)))) @@ -744,6 +764,9 @@ narrowed." (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." @@ -768,22 +791,27 @@ narrowed." (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 (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 (and (consp browse-url-browser-function) - (not (functionp browse-url-browser-function))) + (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 browse-url-browser-function) + (dolist (bf function) (when (string-match (car bf) url) (apply (cdr bf) url args) (throw 'done t))) @@ -791,7 +819,7 @@ Prompts for a URL, defaulting to the URL at or before point. Variable 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)))) + (apply function url args)))) ;;;###autoload (defun browse-url-at-point (&optional arg) @@ -835,7 +863,7 @@ to use." (shell-command (concat "start " (shell-quote-argument url))) (error "Browsing URLs is not supported on this system"))) ((eq system-type 'cygwin) - (shell-command (concat "cygstart " (shell-quote-argument url)))) + (call-process "cygstart" nil nil nil url)) (t (w32-shell-execute "open" url)))) (defun browse-url-default-macosx-browser (url &optional new-window) @@ -864,7 +892,6 @@ one showing the selected frame." (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. @@ -881,6 +908,7 @@ The order attempted is gnome-moz-remote, Mozilla, Firefox, 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) @@ -894,6 +922,38 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3." (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. @@ -1339,6 +1399,10 @@ with possible additional arguments `browse-url-xterm-args'." ;; --- 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. @@ -1359,6 +1423,7 @@ used instead of `browse-url-new-window-flag'." (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 @@ -1431,20 +1496,27 @@ used instead of `browse-url-new-window-flag'." (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 --- @@ -1523,5 +1595,4 @@ from `browse-url-elinks-wrapper'." (provide 'browse-url) -;; arch-tag: d2079573-5c06-4097-9598-f550fba19430 ;;; browse-url.el ends here