cgit.sxemacs.org Git - riece/blob - lisp/url-riece.el

   1 ;;; url-riece --- 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., 59 Temple Place - Suite 330,
  20 ;; Boston, MA 02111-1307, 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)))))
  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