comparison lisp/net/browse-url.el @ 84623:5c69a4b491f6

(browse-url-url-encode-chars): New function. URL-encode some chars in a string. (browse-url-encode-url): Rewrite using the previous function. (browse-url-file-url): Use `browse-url-url-encode-chars'. (browse-url-elinks-sentinel): Fix typo. (browse-url-new-window-flag): Doc change.

84622:f967b253f826

;; Netscape allows you to specify the id of the window you want to
;; control but which window DO you want to control and how do you
;; discover its id?

;; William M. Perry's excellent "w3" WWW browser for
;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
;; has a function w3-follow-url-at-point, but that
;; doesn't let you edit the URL like browse-url.
;; The `gnuserv' package that can be used to control it in another
;; Emacs process is available from

window."
  :type 'boolean
  :group 'browse-url)

(defcustom browse-url-new-window-flag nil
  "If non-nil, always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
commands reverses the effect of this variable.  Requires Netscape version
1.1N or later or XMosaic version 2.5 or later if using those browsers."
  :type 'boolean
  :group 'browse-url)

  :group 'browse-url)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding

(defun browse-url-encode-url (url &optional filename-p)
  "Encode all `confusing' characters in URL.
If FILENAME-P is nil, the confusing characters are [,)$].
Otherwise, the confusing characters are [*\"()',=;?% ]."
  (let ((conf-char (if filename-p "[*\"()',=;?% ]" "[,)$]"))
	(encoded-url (copy-sequence url))
	(s 0))
    (while (setq s (string-match conf-char encoded-url s))
      (setq encoded-url
	    (replace-match (format "%%%x"
				   (string-to-char (match-string 0 encoded-url)))
			   t t encoded-url)
	    s (1+ s)))
    encoded-url))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input

;;;###autoload

Use variable `browse-url-filename-alist' to map filenames to URLs."
  (let ((coding (and default-enable-multibyte-characters
		     (or file-name-coding-system
			 default-file-name-coding-system))))
    (if coding (setq file (encode-coding-string file coding))))
  (setq file (browse-url-encode-url file 'url-is-filename))
  (dolist (map browse-url-filename-alist)
    (when (and map (string-match (car map) file))
      (setq file (replace-match (cdr map) t nil file))))
  file)

The order attempted is gnome-moz-remote, Mozilla, Firefox,
Galeon, Konqueror, Netscape, Mosaic, IXI Mosaic, Lynx in an
xterm, MMM, and then W3."
  (apply
    (cond
     ((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-galeon-program) 'browse-url-galeon)
     ((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 "tellw3b") 'browse-url-iximosaic)
     ((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm)
     ((executable-find "mmm") 'browse-url-mmm)
     ((locate-library "w3") 'browse-url-w3)
     (t
      (lambda (&ignore args) (error "No usable browser found"))))
     url args))

;;;###autoload
(defun browse-url-netscape (url &optional new-window)
  "Ask the Netscape WWW browser to load URL.
Default to the URL around or before point.  The strings in variable

  (interactive)
  ;; Backwards incompatibility reported by
  ;; <[e-mail]>.
  (browse-url-netscape-send (if (>= browse-url-netscape-version 4)
				"xfeDoCommand(reload)"
				"reload")))

(defun browse-url-netscape-send (command)
  "Send a remote control command to Netscape."
  (let* ((process-environment (browse-url-process-environment)))
    (apply 'start-process "netscape" nil

	 nil
	 browse-url-gnome-moz-program
	 (append
	  browse-url-gnome-moz-arguments
	  (if (browse-url-maybe-new-window new-window)
	    '("--newwin"))
	  (list "--raise" url))))

;; --- Mosaic ---

;;;###autoload

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 "W3 URL: "))
  (require 'w3)				; w3-fetch-other-window not autoloaded
  (if (browse-url-maybe-new-window new-window)
      (w3-fetch-other-window url)
    (w3-fetch url)))

;;;###autoload

  ;; new-window ignored
  "Ask another Emacs running gnuserv to load the URL using the W3 browser.
The `browse-url-gnudoit-program' program is used with options given by
`browse-url-gnudoit-args'.  Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "W3 URL: "))
    (apply 'start-process (concat "gnudoit:" url) nil
	   browse-url-gnudoit-program
	   (append browse-url-gnudoit-args
		   (list (concat "(w3-fetch \"" url "\")")
			 "(raise-frame)"))))

;; --- Lynx in an xterm ---

;;;###autoload
(defun browse-url-lynx-xterm (url &optional new-window)

Default to the URL around or before point.  A new Lynx process is run
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"
	     ,url)))

;; --- Lynx in an Emacs "term" window ---

;;;###autoload
(defun browse-url-lynx-emacs (url &optional new-buffer)

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: "))
  (let* ((system-uses-terminfo t)       ; Lynx uses terminfo
	 ;; (term-term-name "vt100") ; ??
	 (buf (get-buffer "*lynx*"))
	 (proc (and buf (get-buffer-process buf)))
	 (n browse-url-lynx-input-attempts))
    (if (and (browse-url-maybe-new-window new-buffer) buf)

      (if (eq (following-char) ?_)
	  (cond ((eq browse-url-lynx-input-field 'warn)
		 (error "Please move out of the input field first"))
		((eq browse-url-lynx-input-field 'avoid)
		 (while (and (eq (following-char) ?_) (> n 0))
		   (term-send-down) ; down arrow
		   (sit-for browse-url-lynx-input-delay))
		 (if (eq (following-char) ?_)
		     (error "Cannot move out of the input field, sorry")))))
      (term-send-string proc (concat "g" ; goto
				     "\C-u" ; kill default url
				     url
				     "\r")))))

;; --- MMM ---

browser is started up in a new process with possible additional arguments
`browse-url-generic-args'.  This is appropriate for browsers which
don't offer a form of remote control."
  (interactive (browse-url-interactive-arg "URL: "))
  (if (not browse-url-generic-program)
    (error "No browser defined (`browse-url-generic-program')"))
  (apply 'call-process browse-url-generic-program nil
	 0 nil
	 (append browse-url-generic-args (list url))))

;;;###autoload

  "Ask the KDE WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "KDE URL: "))
  (message "Sending URL to KDE...")
  (apply #'start-process (concat "KDE " url) nil browse-url-kde-program
	                 (append browse-url-kde-args (list url))))

;;;###autoload
(defun browse-url-elinks (url)
  "Ask the Elinks WWW browser to load URL.
Default to the URL around the point.

from `elinks-browse-url-wrapper'."
  (interactive (browse-url-interactive-arg "URL: "))
  (setq url (browse-url-encode-url url))
  (let ((process-environment (browse-url-process-environment))
	(elinks-ping-process (start-process "elinks-ping" nil
					     "elinks" "-remote" "ping()")))
    (set-process-sentinel elinks-ping-process
			  `(lambda (process change)
			     (browse-url-elinks-sentinel process ,url)))))

(defun browse-url-elinks-sentinel (process url)

  (let ((exit-status (process-exit-status process))
	(process-environment (browse-url-process-environment)))
    ;; Try to determine if an instance is running or if we have to
    ;; create a new one.
    (case exit-status
      (5
       ;; No instance, start a new one.
       (apply #'start-process
	      (append (list (concat "elinks:" url) nil)
		      browse-url-elinks-wrapper
		      (list "elinks" url))))
      (0
       ;; Found an instance, open URL in new tab.
       (start-process (concat "elinks:" url) nil
		      "elinks" "-remote"
		      (concat "openURL(\"" url "\",new-tab)")))
      (otherwise
       (error "Undefined exit-code of process `elinks'.")))))

(provide 'browse-url)

;; arch-tag: d2079573-5c06-4097-9598-f550fba19430
;;; browse-url.el ends here

84623:5c69a4b491f6

;; Netscape allows you to specify the id of the window you want to
;; control but which window DO you want to control and how do you
;; discover its id?

;; William M.  Perry's excellent "w3" WWW browser for
;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
;; has a function w3-follow-url-at-point, but that
;; doesn't let you edit the URL like browse-url.
;; The `gnuserv' package that can be used to control it in another
;; Emacs process is available from

window."
  :type 'boolean
  :group 'browse-url)

(defcustom browse-url-new-window-flag nil
  "Non-nil means always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
commands reverses the effect of this variable.  Requires Netscape version
1.1N or later or XMosaic version 2.5 or later if using those browsers."
  :type 'boolean
  :group 'browse-url)

  :group 'browse-url)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding

(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., \"[,)$]\")."
  (let ((encoded-url (copy-sequence url))
	(s 0))
    (while (setq s (string-match chars encoded-url s))
      (setq encoded-url
	    (replace-match (format "%%%x"
				   (string-to-char (match-string 0 encoded-url)))
			   t t encoded-url)
	    s (1+ s)))
    encoded-url))

(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 "[,)$]"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input

;;;###autoload

Use variable `browse-url-filename-alist' to map filenames to URLs."
  (let ((coding (and default-enable-multibyte-characters
		     (or file-name-coding-system
			 default-file-name-coding-system))))
    (if coding (setq file (encode-coding-string file coding))))
  (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]"))
  (dolist (map browse-url-filename-alist)
    (when (and map (string-match (car map) file))
      (setq file (replace-match (cdr map) t nil file))))
  file)

The order attempted is gnome-moz-remote, Mozilla, Firefox,
Galeon, Konqueror, Netscape, Mosaic, IXI Mosaic, Lynx in an
xterm, MMM, and then W3."
  (apply
   (cond
    ((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-galeon-program) 'browse-url-galeon)
    ((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 "tellw3b") 'browse-url-iximosaic)
    ((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm)
    ((executable-find "mmm") 'browse-url-mmm)
    ((locate-library "w3") 'browse-url-w3)
    (t
     (lambda (&ignore args) (error "No usable browser found"))))
   url args))

;;;###autoload
(defun browse-url-netscape (url &optional new-window)
  "Ask the Netscape WWW browser to load URL.
Default to the URL around or before point.  The strings in variable

  (interactive)
  ;; Backwards incompatibility reported by
  ;; <[e-mail]>.
  (browse-url-netscape-send (if (>= browse-url-netscape-version 4)
				"xfeDoCommand(reload)"
			      "reload")))

(defun browse-url-netscape-send (command)
  "Send a remote control command to Netscape."
  (let* ((process-environment (browse-url-process-environment)))
    (apply 'start-process "netscape" nil

	 nil
	 browse-url-gnome-moz-program
	 (append
	  browse-url-gnome-moz-arguments
	  (if (browse-url-maybe-new-window new-window)
	      '("--newwin"))
	  (list "--raise" url))))

;; --- Mosaic ---

;;;###autoload

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 "W3 URL: "))
  (require 'w3)			; w3-fetch-other-window not autoloaded
  (if (browse-url-maybe-new-window new-window)
      (w3-fetch-other-window url)
    (w3-fetch url)))

;;;###autoload

  ;; new-window ignored
  "Ask another Emacs running gnuserv to load the URL using the W3 browser.
The `browse-url-gnudoit-program' program is used with options given by
`browse-url-gnudoit-args'.  Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "W3 URL: "))
  (apply 'start-process (concat "gnudoit:" url) nil
	 browse-url-gnudoit-program
	 (append browse-url-gnudoit-args
		 (list (concat "(w3-fetch \"" url "\")")
		       "(raise-frame)"))))

;; --- Lynx in an xterm ---

;;;###autoload
(defun browse-url-lynx-xterm (url &optional new-window)

Default to the URL around or before point.  A new Lynx process is run
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"
			   ,url)))

;; --- Lynx in an Emacs "term" window ---

;;;###autoload
(defun browse-url-lynx-emacs (url &optional new-buffer)

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: "))
  (let* ((system-uses-terminfo t)     ; Lynx uses terminfo
	 ;; (term-term-name "vt100") ; ??
	 (buf (get-buffer "*lynx*"))
	 (proc (and buf (get-buffer-process buf)))
	 (n browse-url-lynx-input-attempts))
    (if (and (browse-url-maybe-new-window new-buffer) buf)

      (if (eq (following-char) ?_)
	  (cond ((eq browse-url-lynx-input-field 'warn)
		 (error "Please move out of the input field first"))
		((eq browse-url-lynx-input-field 'avoid)
		 (while (and (eq (following-char) ?_) (> n 0))
		   (term-send-down)	; down arrow
		   (sit-for browse-url-lynx-input-delay))
		 (if (eq (following-char) ?_)
		     (error "Cannot move out of the input field, sorry")))))
      (term-send-string proc (concat "g"    ; goto
				     "\C-u" ; kill default url
				     url
				     "\r")))))

;; --- MMM ---

browser is started up in a new process with possible additional arguments
`browse-url-generic-args'.  This is appropriate for browsers which
don't offer a form of remote control."
  (interactive (browse-url-interactive-arg "URL: "))
  (if (not browse-url-generic-program)
      (error "No browser defined (`browse-url-generic-program')"))
  (apply 'call-process browse-url-generic-program nil
	 0 nil
	 (append browse-url-generic-args (list url))))

;;;###autoload

  "Ask the KDE WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "KDE URL: "))
  (message "Sending URL to KDE...")
  (apply #'start-process (concat "KDE " url) nil browse-url-kde-program
	 (append browse-url-kde-args (list url))))

;;;###autoload
(defun browse-url-elinks (url)
  "Ask the Elinks WWW browser to load URL.
Default to the URL around the point.

from `elinks-browse-url-wrapper'."
  (interactive (browse-url-interactive-arg "URL: "))
  (setq url (browse-url-encode-url url))
  (let ((process-environment (browse-url-process-environment))
	(elinks-ping-process (start-process "elinks-ping" nil
					    "elinks" "-remote" "ping()")))
    (set-process-sentinel elinks-ping-process
			  `(lambda (process change)
			     (browse-url-elinks-sentinel process ,url)))))

(defun browse-url-elinks-sentinel (process url)

  (let ((exit-status (process-exit-status process))
	(process-environment (browse-url-process-environment)))
    ;; Try to determine if an instance is running or if we have to
    ;; create a new one.
    (case exit-status
	  (5
	   ;; No instance, start a new one.
	   (apply #'start-process
		  (append (list (concat "elinks:" url) nil)
			  browse-url-elinks-wrapper
			  (list "elinks" url))))
	  (0
	   ;; Found an instance, open URL in new tab.
	   (start-process (concat "elinks:" url) nil
			  "elinks" "-remote"
			  (concat "openURL(\"" url "\",new-tab)")))
	  (otherwise
	   (error "Undefined exit-code of process `elinks'")))))

(provide 'browse-url)

;; arch-tag: d2079573-5c06-4097-9598-f550fba19430
;;; browse-url.el ends here