From: ueno <ueno>
Date: Fri, 30 May 2003 06:53:09 +0000 (+0000)
Subject: * riece-url.el: New add-on.
X-Git-Tag: riece-0_0_2~4
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a058d65bdd0751aa77fa617af7d22fbc3c610a69;p=elisp%2Friece.git

* riece-url.el: New add-on.
* COMPILE (riece-modules): Add riece-url.
---

diff --git a/lisp/COMPILE b/lisp/COMPILE
index 128ec4e..51445d4 100644
--- a/lisp/COMPILE
+++ b/lisp/COMPILE
@@ -9,7 +9,6 @@
 		riece-options
 		riece-version
 		riece-inlines
-		riece-highlight
 		riece-coding
 		riece-complete
 
@@ -41,7 +40,9 @@
 		riece
 
 		;; add-ons
-		riece-ctcp))))
+		riece-ctcp
+		riece-highlight
+		riece-url))))
 
 (defun riece-compile-modules (modules)
   (let ((load-path (cons nil load-path)))
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dd14f0c..bcccf99 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 2003-05-30  Daiki Ueno  <ueno@unixuser.org>
 
+	* riece-url.el: New add-on.
+	* COMPILE (riece-modules): Add riece-url.
+
 	* riece-message.el (riece-message-make-bracket): Abolish.
 	* riece-highlight.el (riece-highlight-font-lock-keywords):
 	Give up to fontify "-nick-" or "-nick server-".
diff --git a/lisp/riece-url.el b/lisp/riece-url.el
new file mode 100644
index 0000000..105098d
--- /dev/null
+++ b/lisp/riece-url.el
@@ -0,0 +1,69 @@
+;;; riece-url.el --- URL collector add-on
+;; Copyright (C) 1998-2003 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1998-09-28
+;; Keywords: IRC, riece
+
+;; This file is part of Riece.
+
+;; This program 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.
+
+;; This program 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.
+
+;;; Code:
+
+(defvar browse-url-browser-function)
+
+(defgroup riece-url nil
+  "URL Browsing in IRC buffer."
+  :group 'riece-vars)
+
+(defcustom riece-url-regexp  "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]"
+  "Regular expression that matches URLs."
+  :group 'riece-url
+  :type 'regexp)
+
+(defvar riece-urls nil
+  "A list of URL which appears in Riece buffers.")
+
+(autoload 'widget-convert-button "wid-edit")
+
+(defun riece-url-add-buttons (start end)
+  (save-excursion
+    (goto-char start)
+    (while (re-search-forward riece-url-regexp end t)
+      (let ((url (match-string 0)))
+	(widget-convert-button
+	 'url-link (match-beginning 0) (match-end 0) url)
+	(unless (member url riece-urls)
+	  (setq riece-urls (cons url riece-urls)))))))
+
+(defun riece-command-browse-url (&optional url)
+  (interactive
+   (list (completing-read "Open URL:" (mapcar #'list riece-urls))))
+  (browse-url url))
+
+(defvar riece-dialogue-mode-map)
+
+(defun riece-url-requires ()
+  '(riece-highlight))
+
+(defun riece-url-insinuate ()
+  (add-hook 'riece-after-insert-functions 'riece-url-add-buttons)
+  (define-key riece-dialogue-mode-map "U" 'riece-command-browse-url))
+
+(provide 'riece-url)
+
+;;; riece-url.el ends here