Don't use old-style backquote in doc/ptexinfmt.el.
[riece] / lisp / url-riece.el
1 ;;; url-riece.el --- Adapting `riece' to `url-irc'
2 ;; Copyright (C) 2004 Masatake YAMATO
3
4 ;; Author: Masatake YAMATO <jet@gyve.org>
5 ;; Keywords: IRC, riece, url, comm, data, processes
6
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; any later version.
11
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 ;; GNU General Public License for more details.
16
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 ;; Boston, MA 02110-1301, USA.
21
22 ;;; Commentary:
23 ;;
24 ;; With this package you can opne an url which protocol is irc by
25 ;; riece via url package of GNU Emacs.
26 ;;
27 ;; e.g.
28 ;; (url-retrieve-synchronously "irc://irc.gnome.org:6667/#gtk+")
29 ;; (url-mm-url "irc://irc.gnome.org:6667/#gtk+")
30 ;;
31
32 ;;; Code:
33 (require 'riece)
34 (require 'url)
35 (require 'url-irc)
36
37 (defun url-irc-riece-ready-p ()
38   "Riece is active or not.
39 \(If it is active, a server named \"\" may exists.)"
40   (and (boundp 'riece-server-process-alist)
41        riece-server-process-alist))
42
43 ;; Based on the code posted to liece ml by Daiki Ueno <ueno@unixuser.org>
44 ;; Message-Id: <612cb699-83c0-47ad-a991-423c46bc8384@well-done.deisui.org>
45 (defun url-irc-riece-find-server (host &optional port)
46   "Find an entry for HOST:PORT in `riece-server-process-alist'."
47   (unless port (setq port 6667))
48   (catch 'found
49     (let (name name-sans-service plist)
50       (mapc (lambda (pointer)
51               (setq name (car pointer)
52                     name-sans-service (plist-get 
53                                        (riece-server-name-to-server name) 
54                                        :host)
55                     plist (if (equal name "")
56                               riece-server
57                             (cdr (or (assoc name riece-server-alist)
58                                      (assoc name-sans-service riece-server-alist)))))
59               (when (and plist
60                          (equal (plist-get plist :host) host)
61                          (eq (or (plist-get plist :service) 6667) port))
62                 (throw 'found pointer)))
63             riece-server-process-alist)
64       nil)))
65 ;(url-irc-riece-find-server "localhost")
66 ;(url-irc-riece-find-server "localhost" 6667)
67 ;(url-irc-riece-find-server "irc.gnome.org")
68
69 (defun url-irc-riece (host port channel user password)
70   "Adapting `riece' to `url-irc'.
71 See the documentation of `url-irc-function'about HOST, PORT, CHANNEL, USER
72 and PASSWORD. Just give nil to it."
73   (unless user (setq user riece-nickname))
74   (let ((server (if port (format "%s:%d" host port) host)))
75     (cond
76      ((not (url-irc-riece-ready-p))
77       (setq riece-server server)
78       (let ((riece-default-password password)
79             (riece-nickname user))
80         ;; Just start riece
81         (riece))
82       (url-irc-riece host port channel user password))
83      ((not (url-irc-riece-find-server host port))
84       (let ((riece-default-password password)
85             (riece-nickname user))
86         ;; Just open the server
87         (riece-command-open-server server))
88       (url-irc-riece host port channel user password))
89      (t
90       (let ((server-name (car (url-irc-riece-find-server host port))))
91         (riece-command-join 
92          (riece-parse-identity (if (string= server-name "")
93                                    channel
94                                  (format "%s %s" channel server-name)))))
95       ;; Show the windows
96       (riece)))))
97 ; (url-irc-riece "localhost" nil "#mandara" "jetgx" nil)
98 ; (url-irc-riece "localhost" nil "#misc" "jetgx" nil)
99 ; (url-irc-riece "irc.gnome.org" nil "#mandara" "jetgx" nil)
100 ; (url-irc-riece "irc.gnome.org" nil "#misc" "jetgx" nil)
101
102 (setq url-irc-function 'url-irc-riece)
103
104 (provide 'url-riece)
105
106 ;; arch-tag: b54bcdf0-0ee3-447b-bc07-e7329d9f2f45
107 ;;; url-riece.el ends here