;;; browse-url-plus.el --- a little extension for browse-url.el

;; Copyright (C) 1999 by Free Software Foundation, Inc.

;; Author: SHIMADA Mitsunobu <simm-emacs@fan.gr.jp>
;; Keywords: hypermedia, internal, mouse

;; This file is part of GNU Emacs.

;; 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 2, 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This package provides a little extension for browse-url.el,
;; which read a URL (Uniform Resource Locator) from minibuffer,
;; defaulting to the URL around point, and ask a World-Wide Web
;; browser to load it. Additional point to browse-url.el is below:
;; * Enable to select compose-mail function
;; * Enable to use wget as browser
;; * Enable to manipulate browse-url function
;; * Enable to use function-list on XEmacs20.4

;;;;;;;;;;;;;;;;
;;; Code:

(provide 'browse-url-plus)
(require 'browse-url)

;;;;;;;;;;;;;;;;
;; variables

(defvar browse-url-plus-compose-mail-function 'compose-mail
  "Define function, which is used in browse-url-plus-compose-mail function,
to compose mail interactively.

Refered function must have one argument, which means \"To:\" field,
for example: 'compose-mail(which is default), 'mew-send, and so.on.

ex.
\(setq browse-url-plus-compose-mail-function 'mew-send\)
")

(defvar browse-url-plus-wget-exec-file-name "wget"
  "Path or filename of wget executable file.
Default is \"wget\".
")

(defvar browse-url-plus-wget-buffer-name "*browse-url-plus-wget*"
  "Working buffer name for wget.
Default is \"*browse-url-plus-wget*\"
")

(defvar browse-url-plus-wget-destination-option "-P"
  "Command line option which defines destination directory.
This is a prefix option for browse-url-plus-wget-destination-directory.
Default is \"-P\"
")

(defvar browse-url-plus-wget-destination-directory (expand-file-name "~/tmp")
  "Directory where files save.
All result of wget is store in this directory.

Default is \"$HOME/tmp\"
")

(defvar browse-url-plus-wget-report-when-error t
  "Flag to display working buffer when error.
Default is t.
")

(defvar browse-url-plus-wget-beep-when-finished nil
  "Beep flag when wget finished.
Default is nil.
")

;;;;;;;;;;;;;;;;
;; manipulator

(defmacro browse-url-plus (function-name prompt-string browser-list)
  "Manipulator for browse-url function.
1st arg : Function name like browse-url
2nd arg : Prompt message on minibuffer
3rd arg : Browser list like browse-url-browser-function

Remember to make browser-function-list whose name is 3rd arg.
"
  (list 'defun function-name (list 'url '&rest 'args)
	(list 'interactive (list 'browse-url-plus-interactive-arg prompt-string))
	(list 'let (list (list 'browse-url-browser-function browser-list))
	      (if (or (featurep 'xemacs) (>= 19 emacs-major-version))
		  (list 'browse-url-plus-x 'url 'args)
		(list 'browse-url 'url 'args)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; functions from browse-url.el
;; (for Emacs 20.3)

(defun browse-url-plus-url-at-point ()
  (let ((url (thing-at-point 'url)))
    (set-text-properties 0 (length url) nil url)
    url))

;; Having this as a separate function called by the browser-specific
;; functions allows them to be stand-alone commands, making it easier
;; to switch between browsers.

(defun browse-url-plus-interactive-arg (prompt)
  "Read a URL from the minibuffer, prompting with PROMPT.
Default to the URL at or before point.  If invoked with a mouse button,
set point to the position clicked first.  Return a list for use in
`interactive' containing the URL and `browse-url-new-window-p' or its
negation if a prefix argument was given."
  (let ((event (elt (this-command-keys) 0)))
    (and (listp event) (mouse-set-point event)))
  (list (read-string prompt (if (and (boundp 'xemacs-logo) (fboundp 'thing-at-point))
				(browse-url-plus-url-at-point)
			      (browse-url-url-at-point)))
        (not (eq (null browse-url-new-window-p)
                 (null current-prefix-arg)))))

(defun browse-url-plus-x (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.

This function is same as browse-url on Emacs 20.3
"
  (interactive (browse-url-plus-interactive-arg "URL: "))
  (let ((bf browse-url-browser-function) re)
    (while (consp bf)
      (setq re (car (car bf))
	    bf (if (string-match re url)
		   (cdr (car bf))	; The function
		 (cdr bf))))		; More pairs
    (or bf (error "No browser in browse-url-browser-function matching URL %s"
                  url))
    (apply bf url args)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; original functions

(defun browse-url-plus-compose-mail (recipient &optional new-window)
  "Compose mail according to given mail-address.
"
  (interactive (browse-url-interactive-arg "mailto:"))
  (let ((to recipient))
    (if (string= "mailto:" (substring recipient 0 7))
	(setq to (substring recipient 7)))
    (if (and (boundp 'to) (null (string= to ""))
	     (fboundp browse-url-plus-compose-mail-function))
	(funcall browse-url-plus-compose-mail-function to))))

(defun browse-url-plus-wget-sentinel (proc mesg)
  "Sentinel function for browse-url-plus-wget-url.
If error occured and browse-url-plus-wget-report-when-error is t,
display execute-log buffer.
"
  (let ((lfpos (string-match "\012" mesg)))
    (if lfpos
	(setq mesg (substring mesg 0 lfpos)))
    (cond ((eq 'exit (process-status proc))
	   (if browse-url-plus-wget-beep-when-finished
	       (ding t))
	   (if (string= "finished" mesg)
	       (message "Wget succeed.")
	     (message "Wget exited abnormally with code %s."
		      (substring mesg 28))
	     (if browse-url-plus-wget-report-when-error
		 (switch-to-buffer-other-window browse-url-plus-wget-buffer-name)))))))

(defun browse-url-plus-wget-url (url &optional new-window)
  "Get file with wget via HTTP or FTP.
"
  (interactive (browse-url-interactive-arg "Wget URL:"))
  (let ((currbuf (current-buffer))
	(workbuf browse-url-plus-wget-buffer-name))
    (if (string= "mailto:" (substring url 0 7))
	(browse-url-plus-compose-mail url new-window)
      (if (processp 'browse-url-plus-wget-process)
	  (message "Another wget process running, so stop.")
	(if (get-buffer workbuf)
	    (progn (set-buffer workbuf) (erase-buffer) (set-buffer currbuf)))
	(set-process-sentinel
	 (setq browse-url-plus-wget-process
	       (start-process "browse-url-plus-wget"
			      browse-url-plus-wget-buffer-name
			      browse-url-plus-wget-exec-file-name
			      browse-url-plus-wget-destination-option
			      browse-url-plus-wget-destination-directory
			      url))
	 'browse-url-plus-wget-sentinel)))))

;;; browse-url-plus.el ends here