comparison lisp/browse-url.el @ 20167:5bd2ed765d52

Doc fixes. (browse-url): Apply, don't just call, browse-url-choose-browser, so args works properly. (browse-url-maybe-new-window): New function. (browse-url-netscape, browse-url-mosaic, browse-url-cci, browse-url-w3, browse-url-lynx-emacs, browse-url-mail): Use it. (browse-url-lynx-emacs): Don't call term-term-name. (browse-url-lynx-input-field, browse-url-lynx-input-delay, browse-url-lynx-input-attempts): New variables. (browse-url-lynx-emacs): Use any existing Lynx buffer; take care to move off input fields. (After Vladimir Alexiev <[e-mail]>.) (browse-url-mosaic-program): New variable. (browse-url-mosaic): Use browse-url-mosaic-program and browse-url-new-window-p. (browse-url-at-mouse): Use browse-url-new-window-p.

20166:e26933e2b3e8

;; each supported browser.  If the chosen browser is not running, it
;; is started.  Currently there is support for:

;; Function              Browser     Earliest version
;; browse-url-netscape   Netscape    1.1b1	   
;; browse-url-mosaic     XMosaic     <= 2.4
;; browse-url-cci        XMosaic     2.5
;; browse-url-w3         w3          0
;; browse-url-w3-gnudoit w3 remotely
;; browse-url-iximosaic  IXI Mosaic  ?
;; browse-url-lynx-*	 Lynx	     0

;; <URL:http://lynx.browser.org/>.

;; Free graphical browsers that could be used by `browse-url-generic'
;; include Chimera <URL:ftp://ftp.cs.unlv.edu/pub/chimera> and
;; <URL:http://www.unlv.edu/chimera/>, Arena
;; <URL:ftp://ftp.yggdrasil.com/pub/dist/web/arena>, Amaya
;; <URL:ftp://ftp.w3.org/pub/amaya>, mMosaic
;; <URL:ftp://sig.enst.fr/pub/multicast/mMosaic/> (the latter with
;; development support for Java applets).

;; I [Denis Howe] recommend Nelson Minar <[e-mail]>'s excellent
;; html-helper-mode.el for editing HTML and thank Nelson for
;; his many useful comments on this code.
;; <URL:http://www.santafe.edu/%7Enelson/hhm-beta/>

  "*A list of strings to pass to Netscape as arguments."
  :type '(repeat (string :tag "Argument"))
  :group 'browse-url)

(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
  "*A list of strings to pass to Netscape when it starts up.
Defaults to the value of `browse-url-netscape-arguments' at the time
`browse-url' is loaded."
  :type '(repeat (string :tag "Argument"))
  :group 'browse-url)

(defcustom browse-url-new-window-p nil
  "*If non-nil, always open a new browser window.
Passing an interactive argument to \\[browse-url-netscape] or
\\[browse-url-cci] reverses the effect of this variable.  Requires
Netscape version 1.1N or later or XMosaic version 2.5 or later."
  :type 'boolean
  :group 'browse-url)

(defcustom browse-url-netscape-display nil
  "*The X display for running Netscape, if not same as Emacs's."
  :type '(choice string (const nil))
  :group 'browse-url)

(defcustom browse-url-mosaic-arguments nil
  "*A list of strings to pass to Mosaic as arguments."
  :type '(repeat (string :tag "Argument"))

(defvar browse-url-save-file nil
  "If non-nil, save the buffer before displaying its file.
Used by the `browse-url-of-file' command.")

(defvar browse-url-of-file-hook nil
  "A hook to be run with run-hook after `browse-url-of-file' has asked
a browser to load a file.

Set this to `browse-url-netscape-reload' to force Netscape to load the
file rather than displaying a cached copy.")

(defvar browse-url-usr1-signal

  :type '(repeat (string :tag "Argument"))
  :group 'browse-url)

(defcustom browse-url-temp-dir
  (or (getenv "TMPDIR") "/tmp")
  "*The name of a directory in which to store temporary files
generated by functions like `browse-url-of-region'.  You might want to
set this to somewhere with restricted read permissions for privacy's sake."
  :type 'string
  :group 'browse-url)

(defcustom browse-url-netscape-version
  3
  "*The version of Netscape you are using.
This affects how URL reloading is done; the mechanism changed
incompatibly at version 4."
  :type 'number
  :group 'browse-url)

(defvar browse-url-temp-file-list '())

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

  (let ((event (elt (this-command-keys) 0)))
    (and (listp event) (mouse-set-point event)))
  (list (read-string prompt (browse-url-url-at-point))
	(not (eq (null browse-url-new-window-p)
		 (null current-prefix-arg)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browse current buffer

;;;###autoload

  "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."
  (interactive (browse-url-interactive-arg "URL: "))
  (if (consp browse-url-browser-function)
      (browse-url-choose-browser args)
    (apply browse-url-browser-function args)))

(defun browse-url-choose-browser (url &rest args)
  "Pass URL to a browser function chosen.
This is done according to the association list in variable

	(error "No browser in browse-url-browser-function matching URL %s" url))))

;;;###autoload
(defun browse-url-at-point ()
  "Ask a WWW browser to load the URL at or before point.
Doesn't let you edit the URL like browse-url.  Variable
`browse-url-browser-function' says which browser to use."
  (interactive)
  (browse-url (browse-url-url-at-point)))

(defun browse-url-event-buffer (event)

;;;###autoload
(defun browse-url-at-mouse (event)
  "Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
but point is not changed.  Doesn't let you edit the URL like
browse-url.  Variable `browse-url-browser-function' says which browser
to use."
  (interactive "e")
  (save-excursion
    (set-buffer (browse-url-event-buffer event))
    (goto-char (browse-url-event-point event))
    (let ((url (browse-url-url-at-point)))
      (if (string-equal url "")
	  (error "No URL found"))
      (browse-url url))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browser-specific commands

;; --- Netscape ---

	(cons (concat "DISPLAY=" display) process-environment)
      process-environment)))

(defun browse-url-emacs-display ()
  "Return the X display Emacs is running on.
This nil if the display is the same as the DISPLAY environment variable.

Actually Emacs could be using several screens on several displays, as
listed by (emacs-display-list) and (x-display-screens DISPLAY), this
just returns the display showing the selected frame.  You got a
problem with that?"

				(if (eq window-system 'w32)
				    (list url)
				  (if new-window '("-noraise"))
				  (list "-remote" 
					(concat "openURL(" url 
						(if new-window ",new-window")
						")")))))))
    (set-process-sentinel process
			  (list 'lambda '(process change)
				(list 'browse-url-netscape-sentinel 'process url)))))

	(apply 'start-process (concat "netscape" url) nil
	       browse-url-netscape-program
	       (append browse-url-netscape-startup-arguments (list url))))))

(defun browse-url-netscape-reload ()
  "Ask Netscape to reload its current document."
  (interactive)
  ;; Backwards incompatibility reported by
  ;; <[e-mail]>.
  (browse-url-netscape-send (if (>= browse-url-netscape-version 4)
				"xfeDoCommand(reload)"

;;;###autoload
(defun browse-url-mosaic (url &optional new-window)
  ;; new-window ignored
  "Ask the XMosaic WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "Mosaic URL: "))
  (let ((pidfile (expand-file-name "~/.mosaicpid"))
	pid pidbuf)
    (if (file-readable-p pidfile)
	(save-excursion

	  (kill-buffer nil)))
    (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
	(save-excursion
	  (find-file (format "/tmp/Mosaic.%d" pid))
	  (erase-buffer)
	  (insert "goto\n" url "\n")
	  (save-buffer)
	  (kill-buffer nil)
	  ;; Send signal SIGUSR to Mosaic
	  (message "Signalling Mosaic...")
	  (signal-process pid browse-url-usr1-signal)

	  ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
	  (message "Signalling Mosaic...done")
	  )
      ;; Mosaic not running - start it
      (message "Starting Mosaic...")
      (apply 'start-process "xmosaic" nil "xmosaic"
	     (append browse-url-mosaic-arguments (list url)))
      (message "Starting Mosaic...done"))))

;; --- Grail ---

  (open-network-stream "browse-url" " *browse-url*"
		       browse-url-CCI-host browse-url-CCI-port)
  ;; Todo: start browser if fails
  (process-send-string "browse-url"
		       (concat "get url (" url ") output "
			       (if new-window "new" "current") "\r\n"))
  (process-send-string "browse-url" "disconnect\r\n")
  (delete-process "browse-url"))

;; --- IXI Mosaic ---

(defun browse-url-w3 (url &optional new-window)
  ;; new-window ignored
  "Ask the w3 WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "W3 URL: "))
  (w3-fetch url))

;;;###autoload
(defun browse-url-w3-gnudoit (url &optional new-window)
  ;; new-window ignored
  "Ask another Emacs running gnuserv to load the URL using the W3 browser.

             (append browse-url-xterm-args (list "-e" "lynx" url))))

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

;;;###autoload
(defun browse-url-lynx-emacs (url &optional new-window)
  ;; new-window ignored
  "Ask the Lynx WWW browser to load URL.
Default to the URL around or before point.  Run a new Lynx process in
an Emacs buffer."
  (interactive (browse-url-interactive-arg "Lynx URL: "))
  (let ((system-uses-terminfo t))	; Lynx uses terminfo
    (if (fboundp 'make-term)
	(let ((term-term-name "vt100"))
	  (set-buffer (make-term "browse-url" "lynx" nil url))
	  (term-mode)
	  (term-char-mode)
	  (switch-to-buffer "*browse-url*"))
      (terminal-emulator "*browse-url*" "lynx" (list url)))))

;; --- MMM ---

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

recipient's address.  Supplying a non-nil interactive prefix argument
will cause the mail to be composed in another window rather than the
current one."
  (interactive (browse-url-interactive-arg "Mailto URL: "))
  (save-excursion
    (let ((func (if new-window
		    'compose-mail-other-window
		  'compose-mail))
	  (to (if (string-match "^mailto:" url)
		  (substring url 7)
		url)))

20167:5bd2ed765d52

;; each supported browser.  If the chosen browser is not running, it
;; is started.  Currently there is support for:

;; Function              Browser     Earliest version
;; browse-url-netscape   Netscape    1.1b1	   
;; browse-url-mosaic     XMosaic/mMosaic <= 2.4
;; browse-url-cci        XMosaic     2.5
;; browse-url-w3         w3          0
;; browse-url-w3-gnudoit w3 remotely
;; browse-url-iximosaic  IXI Mosaic  ?
;; browse-url-lynx-*	 Lynx	     0

;; <URL:http://lynx.browser.org/>.

;; Free graphical browsers that could be used by `browse-url-generic'
;; include Chimera <URL:ftp://ftp.cs.unlv.edu/pub/chimera> and
;; <URL:http://www.unlv.edu/chimera/>, Arena
;; <URL:ftp://ftp.yggdrasil.com/pub/dist/web/arena> and Amaya
;; <URL:ftp://ftp.w3.org/pub/amaya>.  mMosaic
;; <URL:ftp://sig.enst.fr/pub/multicast/mMosaic/> (with development
;; support for Java applets and multicast) can be used like Mosaic by
;; setting `browse-url-mosaic-program' appropriately.

;; I [Denis Howe] recommend Nelson Minar <[e-mail]>'s excellent
;; html-helper-mode.el for editing HTML and thank Nelson for
;; his many useful comments on this code.
;; <URL:http://www.santafe.edu/%7Enelson/hhm-beta/>

  "*A list of strings to pass to Netscape as arguments."
  :type '(repeat (string :tag "Argument"))
  :group 'browse-url)

(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
  "*A list of strings to pass to Netscape when it start up.
Defaults to the value of `browse-url-netscape-arguments' at the time
`browse-url' is loaded."
  :type '(repeat (string :tag "Argument"))
  :group 'browse-url)

(defcustom browse-url-new-window-p nil
  "*If non-nil, always open a new browser window.
Passing an interactive argument to \\[browse-url-netscape],
\\[browse-url-mosaic] or \\[browse-url-cci] reverses the effect of
this variable.  Requires Netscape version 1.1N or later or XMosaic
version 2.5 or later."
  :type 'boolean
  :group 'browse-url)

(defcustom browse-url-netscape-display nil
  "*The X display for running Netscape, if not same as Emacs'."
  :type '(choice string (const nil))
  :group 'browse-url)

(defcustom browse-url-mosaic-program "xmosaic"
  "*The name by which to invoke Mosaic (or mMosaic)."
  :type 'string
  :group 'browse-url)

(defcustom browse-url-mosaic-arguments nil
  "*A list of strings to pass to Mosaic as arguments."
  :type '(repeat (string :tag "Argument"))

(defvar browse-url-save-file nil
  "If non-nil, save the buffer before displaying its file.
Used by the `browse-url-of-file' command.")

(defvar browse-url-of-file-hook nil
  "Run after `browse-url-of-file' has asked a browser to load a file.

Set this to `browse-url-netscape-reload' to force Netscape to load the
file rather than displaying a cached copy.")

(defvar browse-url-usr1-signal

  :type '(repeat (string :tag "Argument"))
  :group 'browse-url)

(defcustom browse-url-temp-dir
  (or (getenv "TMPDIR") "/tmp")
  "*The name of a directory for browse-url's temporary files.
Such files are generated by functions like `browse-url-of-region'.
You might want to set this to somewhere with restricted read permissions
for privacy's sake."
  :type 'string
  :group 'browse-url)

(defcustom browse-url-netscape-version
  3
  "*The version of Netscape you are using.
This affects how URL reloading is done; the mechanism changed
incompatibly at version 4."
  :type 'number
  :group 'browse-url)

(defvar browse-url-lynx-input-field 'avoid
  "*Action on selecting an existing Lynx buffer at an input field.
What to do when sending a new URL to an existing Lynx buffer in Emacs
if the Lynx cursor is on an input field (in which case the `g' command
would be entered as data).  Such fields are recognized by the
underlines ____.  Allowed values: nil: disregard it, 'warn: warn the
user and don't emit the URL, 'avoid: try to avoid the field by moving
down (this *won't* always work).")

(defvar browse-url-lynx-input-attempts 10
  "*How many times to try to move down from a series of lynx input fields.")

(defvar browse-url-lynx-input-delay 0.2
  "*How many seconds to wait for lynx between moves down from an input field.")

(defvar browse-url-temp-file-list '())

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

  (let ((event (elt (this-command-keys) 0)))
    (and (listp event) (mouse-set-point event)))
  (list (read-string prompt (browse-url-url-at-point))
	(not (eq (null browse-url-new-window-p)
		 (null current-prefix-arg)))))

(defun browse-url-maybe-new-window (arg)
  (if (interactive-p)
      arg
    browse-url-new-window-p))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browse current buffer

;;;###autoload

  "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."
  (interactive (browse-url-interactive-arg "URL: "))
  (if (consp browse-url-browser-function)
      (apply browse-url-choose-browser args)
    (apply browse-url-browser-function args)))

(defun browse-url-choose-browser (url &rest args)
  "Pass URL to a browser function chosen.
This is done according to the association list in variable

	(error "No browser in browse-url-browser-function matching URL %s" url))))

;;;###autoload
(defun browse-url-at-point ()
  "Ask a WWW browser to load the URL at or before point.
Doesn't let you edit the URL like `browse-url'.  Variable
`browse-url-browser-function' says which browser to use."
  (interactive)
  (browse-url (browse-url-url-at-point)))

(defun browse-url-event-buffer (event)

;;;###autoload
(defun browse-url-at-mouse (event)
  "Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
but point is not changed.  Doesn't let you edit the URL like
`browse-url'.  Variable `browse-url-browser-function' says which browser
to use."
  (interactive "e")
  (save-excursion
    (set-buffer (browse-url-event-buffer event))
    (goto-char (browse-url-event-point event))
    (let ((url (browse-url-url-at-point)))
      (if (string-equal url "")
	  (error "No URL found"))
      (browse-url url browse-url-new-window-p))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browser-specific commands

;; --- Netscape ---

	(cons (concat "DISPLAY=" display) process-environment)
      process-environment)))

(defun browse-url-emacs-display ()
  "Return the X display Emacs is running on.
This is nil if the display is the same as the DISPLAY environment variable.

Actually Emacs could be using several screens on several displays, as
listed by (emacs-display-list) and (x-display-screens DISPLAY), this
just returns the display showing the selected frame.  You got a
problem with that?"

				(if (eq window-system 'w32)
				    (list url)
				  (if new-window '("-noraise"))
				  (list "-remote" 
					(concat "openURL(" url 
						(if (browse-url-maybe-new-window
						     new-window)
						    ",new-window")
						")")))))))
    (set-process-sentinel process
			  (list 'lambda '(process change)
				(list 'browse-url-netscape-sentinel 'process url)))))

	(apply 'start-process (concat "netscape" url) nil
	       browse-url-netscape-program
	       (append browse-url-netscape-startup-arguments (list url))))))

(defun browse-url-netscape-reload ()
  "Ask Netscape to reload its current document.
How depends on `browse-url-netscape-version'."
  (interactive)
  ;; Backwards incompatibility reported by
  ;; <[e-mail]>.
  (browse-url-netscape-send (if (>= browse-url-netscape-version 4)
				"xfeDoCommand(reload)"

;;;###autoload
(defun browse-url-mosaic (url &optional new-window)
  ;; new-window ignored
  "Ask the XMosaic WWW browser to load URL.

Default to the URL around or before point.  The strings in variable
`browse-url-mosaic-arguments' are also passed to Mosaic and the
program is invoked according to the variable
`browse-url-mosaic-program'.

When called interactively, if variable `browse-url-new-window-p' is
non-nil, load the document in a new Mosaic window, otherwise use a
random existing one.  A non-nil interactive prefix argument reverses
the effect of `browse-url-new-window-p'.

When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-p'."
  (interactive (browse-url-interactive-arg "Mosaic URL: "))
  (let ((pidfile (expand-file-name "~/.mosaicpid"))
	pid pidbuf)
    (if (file-readable-p pidfile)
	(save-excursion

	  (kill-buffer nil)))
    (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
	(save-excursion
	  (find-file (format "/tmp/Mosaic.%d" pid))
	  (erase-buffer)
	  (insert (if (browse-url-maybe-new-window new-window)
		      "newwin\n"
		      "goto\n")
		  url "\n")
	  (save-buffer)
	  (kill-buffer nil)
	  ;; Send signal SIGUSR to Mosaic
	  (message "Signalling Mosaic...")
	  (signal-process pid browse-url-usr1-signal)

	  ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
	  (message "Signalling Mosaic...done")
	  )
      ;; Mosaic not running - start it
      (message "Starting Mosaic...")
      (apply 'start-process "xmosaic" nil browse-url-mosaic-program
	     (append browse-url-mosaic-arguments (list url)))
      (message "Starting Mosaic...done"))))

;; --- Grail ---

  (open-network-stream "browse-url" " *browse-url*"
		       browse-url-CCI-host browse-url-CCI-port)
  ;; Todo: start browser if fails
  (process-send-string "browse-url"
		       (concat "get url (" url ") output "
			       (if (browse-url-maybe-new-window
				    new-window)
				   "new"
				 "current")
			       "\r\n"))
  (process-send-string "browse-url" "disconnect\r\n")
  (delete-process "browse-url"))

;; --- IXI Mosaic ---

(defun browse-url-w3 (url &optional new-window)
  ;; new-window ignored
  "Ask the w3 WWW browser to load URL.
Default to the URL around or before point."
  (interactive (browse-url-interactive-arg "W3 URL: "))
  (if (browse-url-maybe-new-window new-window)
      (w3-fetch-other-window)
    (w3-fetch url)))

;;;###autoload
(defun browse-url-w3-gnudoit (url &optional new-window)
  ;; new-window ignored
  "Ask another Emacs running gnuserv to load the URL using the W3 browser.

             (append browse-url-xterm-args (list "-e" "lynx" url))))

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

;;;###autoload
(defun browse-url-lynx-emacs (url &optional new-buffer)
  "Ask the Lynx WWW browser to load URL.
Default to the URL around or before point.  With a prefix argument, run
a new Lynx process in a new buffer."
  (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)
	;; Rename away the OLD buffer. This isn't very polite, but
	;; term insists on working in a buffer named *lynx* and would
	;; choke on *lynx*<1>
	(progn (set-buffer buf)
	       (rename-uniquely)))
    (if (or (browse-url-maybe-new-window new-buffer)
	    (not buf)
	    (not proc)
	    (not (memq (process-status proc) '(run stop))))
	;; start a new lynx
	(progn (switch-to-buffer (make-term "lynx" "lynx" nil url))
	       (term-char-mode))
      ;; send the url to lynx in the old buffer
      (let ((win (get-buffer-window buf t)))
	(if win
	    (select-window win)
	  (switch-to-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 ---

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

recipient's address.  Supplying a non-nil interactive prefix argument
will cause the mail to be composed in another window rather than the
current one."
  (interactive (browse-url-interactive-arg "Mailto URL: "))
  (save-excursion
    (let ((func (if (browse-url-maybe-new-window new-window)
		    'compose-mail-other-window
		  'compose-mail))
	  (to (if (string-match "^mailto:" url)
		  (substring url 7)
		url)))