home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / irchat-pj / 2.5 / irchat-pj-2.5.6p.tar.gz / irchat-pj-2.5.6p.tar / irchat-pj-2.5.6p / contrib / browse-url-plus.el next >
Lisp/Scheme  |  2000-07-31  |  7KB  |  207 lines
  1. ;;; browse-url-plus.el --- a little extension for browse-url.el
  2.  
  3. ;; Copyright (C) 1999 by Free Software Foundation, Inc.
  4.  
  5. ;; Author: SHIMADA Mitsunobu <simm-emacs@fan.gr.jp>
  6. ;; Keywords: hypermedia, internal, mouse
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This package provides a little extension for browse-url.el,
  28. ;; which read a URL (Uniform Resource Locator) from minibuffer,
  29. ;; defaulting to the URL around point, and ask a World-Wide Web
  30. ;; browser to load it. Additional point to browse-url.el is below:
  31. ;; * Enable to select compose-mail function
  32. ;; * Enable to use wget as browser
  33. ;; * Enable to manipulate browse-url function
  34. ;; * Enable to use function-list on XEmacs20.4
  35.  
  36. ;;;;;;;;;;;;;;;;
  37. ;;; Code:
  38.  
  39. (provide 'browse-url-plus)
  40. (require 'browse-url)
  41.  
  42. ;;;;;;;;;;;;;;;;
  43. ;; variables
  44.  
  45. (defvar browse-url-plus-compose-mail-function 'compose-mail
  46.   "Define function, which is used in browse-url-plus-compose-mail function,
  47. to compose mail interactively.
  48.  
  49. Refered function must have one argument, which means \"To:\" field,
  50. for example: 'compose-mail(which is default), 'mew-send, and so.on.
  51.  
  52. ex.
  53. \(setq browse-url-plus-compose-mail-function 'mew-send\)
  54. ")
  55.  
  56. (defvar browse-url-plus-wget-exec-file-name "wget"
  57.   "Path or filename of wget executable file.
  58. Default is \"wget\".
  59. ")
  60.  
  61. (defvar browse-url-plus-wget-buffer-name "*browse-url-plus-wget*"
  62.   "Working buffer name for wget.
  63. Default is \"*browse-url-plus-wget*\"
  64. ")
  65.  
  66. (defvar browse-url-plus-wget-destination-option "-P"
  67.   "Command line option which defines destination directory.
  68. This is a prefix option for browse-url-plus-wget-destination-directory.
  69. Default is \"-P\"
  70. ")
  71.  
  72. (defvar browse-url-plus-wget-destination-directory (expand-file-name "~/tmp")
  73.   "Directory where files save.
  74. All result of wget is store in this directory.
  75.  
  76. Default is \"$HOME/tmp\"
  77. ")
  78.  
  79. (defvar browse-url-plus-wget-report-when-error t
  80.   "Flag to display working buffer when error.
  81. Default is t.
  82. ")
  83.  
  84. (defvar browse-url-plus-wget-beep-when-finished nil
  85.   "Beep flag when wget finished.
  86. Default is nil.
  87. ")
  88.  
  89. ;;;;;;;;;;;;;;;;
  90. ;; manipulator
  91.  
  92. (defmacro browse-url-plus (function-name prompt-string browser-list)
  93.   "Manipulator for browse-url function.
  94. 1st arg : Function name like browse-url
  95. 2nd arg : Prompt message on minibuffer
  96. 3rd arg : Browser list like browse-url-browser-function
  97.  
  98. Remember to make browser-function-list whose name is 3rd arg.
  99. "
  100.   (list 'defun function-name (list 'url '&rest 'args)
  101.     (list 'interactive (list 'browse-url-plus-interactive-arg prompt-string))
  102.     (list 'let (list (list 'browse-url-browser-function browser-list))
  103.           (if (or (featurep 'xemacs) (>= 19 emacs-major-version))
  104.           (list 'browse-url-plus-x 'url 'args)
  105.         (list 'browse-url 'url 'args)))))
  106.  
  107. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  108. ;; functions from browse-url.el
  109. ;; (for Emacs 20.3)
  110.  
  111. (defun browse-url-plus-url-at-point ()
  112.   (let ((url (thing-at-point 'url)))
  113.     (set-text-properties 0 (length url) nil url)
  114.     url))
  115.  
  116. ;; Having this as a separate function called by the browser-specific
  117. ;; functions allows them to be stand-alone commands, making it easier
  118. ;; to switch between browsers.
  119.  
  120. (defun browse-url-plus-interactive-arg (prompt)
  121.   "Read a URL from the minibuffer, prompting with PROMPT.
  122. Default to the URL at or before point.  If invoked with a mouse button,
  123. set point to the position clicked first.  Return a list for use in
  124. `interactive' containing the URL and `browse-url-new-window-p' or its
  125. negation if a prefix argument was given."
  126.   (let ((event (elt (this-command-keys) 0)))
  127.     (and (listp event) (mouse-set-point event)))
  128.   (list (read-string prompt (if (and (boundp 'xemacs-logo) (fboundp 'thing-at-point))
  129.                 (browse-url-plus-url-at-point)
  130.                   (browse-url-url-at-point)))
  131.         (not (eq (null browse-url-new-window-p)
  132.                  (null current-prefix-arg)))))
  133.  
  134. (defun browse-url-plus-x (url &rest args)
  135.   "Ask a WWW browser to load URL.
  136. Prompts for a URL, defaulting to the URL at or before point.  Variable
  137. `browse-url-browser-function' says which browser to use.
  138.  
  139. This function is same as browse-url on Emacs 20.3
  140. "
  141.   (interactive (browse-url-plus-interactive-arg "URL: "))
  142.   (let ((bf browse-url-browser-function) re)
  143.     (while (consp bf)
  144.       (setq re (car (car bf))
  145.         bf (if (string-match re url)
  146.            (cdr (car bf))    ; The function
  147.          (cdr bf))))        ; More pairs
  148.     (or bf (error "No browser in browse-url-browser-function matching URL %s"
  149.                   url))
  150.     (apply bf url args)))
  151.  
  152. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  153. ;; original functions
  154.  
  155. (defun browse-url-plus-compose-mail (recipient &optional new-window)
  156.   "Compose mail according to given mail-address.
  157. "
  158.   (interactive (browse-url-interactive-arg "mailto:"))
  159.   (let ((to recipient))
  160.     (if (string= "mailto:" (substring recipient 0 7))
  161.     (setq to (substring recipient 7)))
  162.     (if (and (boundp 'to) (null (string= to ""))
  163.          (fboundp browse-url-plus-compose-mail-function))
  164.     (funcall browse-url-plus-compose-mail-function to))))
  165.  
  166. (defun browse-url-plus-wget-sentinel (proc mesg)
  167.   "Sentinel function for browse-url-plus-wget-url.
  168. If error occured and browse-url-plus-wget-report-when-error is t,
  169. display execute-log buffer.
  170. "
  171.   (let ((lfpos (string-match "\012" mesg)))
  172.     (if lfpos
  173.     (setq mesg (substring mesg 0 lfpos)))
  174.     (cond ((eq 'exit (process-status proc))
  175.        (if browse-url-plus-wget-beep-when-finished
  176.            (ding t))
  177.        (if (string= "finished" mesg)
  178.            (message "Wget succeed.")
  179.          (message "Wget exited abnormally with code %s."
  180.               (substring mesg 28))
  181.          (if browse-url-plus-wget-report-when-error
  182.          (switch-to-buffer-other-window browse-url-plus-wget-buffer-name)))))))
  183.  
  184. (defun browse-url-plus-wget-url (url &optional new-window)
  185.   "Get file with wget via HTTP or FTP.
  186. "
  187.   (interactive (browse-url-interactive-arg "Wget URL:"))
  188.   (let ((currbuf (current-buffer))
  189.     (workbuf browse-url-plus-wget-buffer-name))
  190.     (if (string= "mailto:" (substring url 0 7))
  191.     (browse-url-plus-compose-mail url new-window)
  192.       (if (processp 'browse-url-plus-wget-process)
  193.       (message "Another wget process running, so stop.")
  194.     (if (get-buffer workbuf)
  195.         (progn (set-buffer workbuf) (erase-buffer) (set-buffer currbuf)))
  196.     (set-process-sentinel
  197.      (setq browse-url-plus-wget-process
  198.            (start-process "browse-url-plus-wget"
  199.                   browse-url-plus-wget-buffer-name
  200.                   browse-url-plus-wget-exec-file-name
  201.                   browse-url-plus-wget-destination-option
  202.                   browse-url-plus-wget-destination-directory
  203.                   url))
  204.      'browse-url-plus-wget-sentinel)))))
  205.  
  206. ;;; browse-url-plus.el ends here
  207.