X-Git-Url: http://cgit.sxemacs.org/?p=packages;a=blobdiff_plain;f=xemacs-packages%2Friece%2Flisp%2Friece-channel.el;fp=xemacs-packages%2Friece%2Flisp%2Friece-channel.el;h=08f06c146097e2db148c58f8ec6418837911cd24;hp=0000000000000000000000000000000000000000;hb=0d227e3a90a83eee3d978d425445df0ccc569f01;hpb=ddbcce55bee95abbe2d79a9aa26ee08a47b284db diff --git a/xemacs-packages/riece/lisp/riece-channel.el b/xemacs-packages/riece/lisp/riece-channel.el new file mode 100644 index 00000000..08f06c14 --- /dev/null +++ b/xemacs-packages/riece/lisp/riece-channel.el @@ -0,0 +1,234 @@ +;;; riece-channel.el --- a channel object -*- lexical-binding: t -*- +;; Copyright (C) 1998-2003 Daiki Ueno + +;; Author: Daiki Ueno +;; 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., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Code: + +(require 'riece-options) +(require 'riece-globals) +(require 'riece-identity) +(require 'riece-mode) +(require 'riece-cache) + +;;; Channel object: +(defun riece-find-channel (name) + "Get a channel object named NAME from the server buffer." + (riece-cache-get riece-channel-cache name) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-channel-obarray))) + (if symbol + (symbol-value symbol)))) + +(defun riece-forget-channel (name) + (riece-cache-delete riece-channel-cache name) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-channel-obarray))) + (when symbol + (makunbound symbol) + (unintern (symbol-name symbol) riece-channel-obarray)))) + +(defun riece-make-channel (users topic modes banned invited uninvited key) + "Make an instance of channel object. +Arguments are appropriate to channel users, topic, modes, banned +users, invited users, uninvited users, and the channel key, +respectively." + (vector users topic modes banned invited uninvited key)) + +(defun riece-get-channel (name) + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name) + riece-channel-obarray))) + (if symbol + (progn + (riece-cache-get riece-channel-cache name) + (symbol-value symbol)) + (riece-cache-set riece-channel-cache name name) + (set (intern (riece-identity-canonicalize-prefix name) + riece-channel-obarray) + (riece-make-channel nil nil nil nil nil nil nil))))) + +(defun riece-channel-users (channel) + "Return the users of CHANNEL." + (aref channel 0)) + +(defun riece-channel-topic (channel) + "Return the topic of CHANNEL." + (aref channel 1)) + +(defun riece-channel-modes (channel) + "Return the modes of CHANNEL." + (aref channel 2)) + +(defun riece-channel-banned (channel) + "Return the banned users of CHANNEL." + (aref channel 3)) + +(defun riece-channel-invited (channel) + "Return the invited users of CHANNEL." + (aref channel 4)) + +(defun riece-channel-uninvited (channel) + "Return the uninvited users of CHANNEL." + (aref channel 5)) + +(defun riece-channel-key (channel) + "Return the key of CHANNEL." + (aref channel 6)) + +(defun riece-channel-set-users (channel value) + "Set the users of CHANNEL to VALUE." + (aset channel 0 value)) + +(defun riece-channel-set-topic (channel value) + "Set the topic of CHANNEL to VALUE." + (aset channel 1 value)) + +(defun riece-channel-set-modes (channel value) + "Set the modes of CHANNEL to VALUE." + (aset channel 2 value)) + +(defun riece-channel-set-banned (channel value) + "Set the banned users of CHANNEL to VALUE." + (aset channel 3 value)) + +(defun riece-channel-set-invited (channel value) + "Set the invited users of CHANNEL to VALUE." + (aset channel 4 value)) + +(defun riece-channel-set-uninvited (channel value) + "Set the uninvited users of CHANNEL to VALUE." + (aset channel 5 value)) + +(defun riece-channel-set-key (channel value) + "Set the key of CHANNEL to VALUE." + (aset channel 6 value)) + +(defun riece-channel-get-users (name) + "Return channel's users as list." + (riece-channel-users (riece-get-channel name))) + +(defun riece-channel-get-topic (name) + "Return channel's topic." + (riece-channel-topic (riece-get-channel name))) + +(defun riece-channel-get-modes (name) + "Return channel's modes as list." + (riece-channel-modes (riece-get-channel name))) + +(defun riece-channel-get-banned (name) + "Return channel's banned users as list." + (riece-channel-banned (riece-get-channel name))) + +(defun riece-channel-get-invited (name) + "Return channel's invited users as list." + (riece-channel-invited (riece-get-channel name))) + +(defun riece-channel-get-uninvited (name) + "Return channel's uninvited users as list." + (riece-channel-uninvited (riece-get-channel name))) + +(defun riece-channel-get-key (name) + "Return channel's key." + (riece-channel-key (riece-get-channel name))) + +;;; Functions called from `riece-handle-mode-message': +(defun riece-channel-toggle-mode (name mode flag) + "Add or remove channel MODE of channel." + (let* ((channel (riece-get-channel name)) + (modes (riece-channel-modes channel)) + (old (riece-mode-assoc (riece-mode-flag mode) modes))) + (if flag + (unless old + (riece-channel-set-modes channel (cons mode modes))) + (if old + (riece-channel-set-modes channel (delq old modes)))))) + +(defun riece-channel-toggle-banned (name pattern flag) + "Add or remove banned PATTERN of channel." + (let* ((channel (riece-get-channel name)) + (banned (riece-channel-banned channel))) + (if flag + (unless (member pattern banned) + (riece-channel-set-banned channel (cons pattern banned))) + (if (setq pattern (car (member pattern banned))) + (riece-channel-set-banned channel (delq pattern banned)))))) + +(defun riece-channel-toggle-invited (name pattern flag) + "Add or remove invited PATTERN of channel." + (let* ((channel (riece-get-channel name)) + (invited (riece-channel-invited channel))) + (if flag + (unless (member pattern invited) + (riece-channel-set-invited channel (cons pattern invited))) + (if (setq pattern (car (member pattern invited))) + (riece-channel-set-invited channel (delq pattern invited)))))) + +(defun riece-channel-toggle-uninvited (name pattern flag) + "Add or remove uninvited PATTERN to channel." + (let* ((channel (riece-get-channel name)) + (uninvited (riece-channel-uninvited channel))) + (if flag + (unless (member pattern uninvited) + (riece-channel-set-uninvited channel (cons pattern uninvited))) + (if (setq pattern (car (member pattern uninvited))) + (riece-channel-set-uninvited + channel (delq pattern uninvited)))))) + +(defun riece-channel-toggle-user (name user flag) + "Add or remove an user to channel." + (let* ((channel (riece-get-channel name)) + (users (riece-channel-users channel))) + (if flag + (unless (riece-identity-assoc user users t) + (riece-channel-set-users channel (cons (list user) users))) + (if (setq user (riece-identity-assoc user users t)) + (riece-channel-set-users channel (delq user users)))))) + +(defun riece-channel-toggle-operator (name user flag) + "Add or remove an operator to channel." + (let* ((channel (riece-get-channel name)) + (users (riece-channel-users channel))) + (setq user (riece-identity-assoc user users t)) + (if flag + (if user + (unless (memq ?o (cdr user)) + (setcdr user (cons ?o (cdr user)))) + (riece-channel-set-users channel (cons (list user ?o) users))) + (if user + (setcdr user (delq ?o (cdr user))))))) + +(defun riece-channel-toggle-speaker (name user flag) + "Add or remove an speaker to channel." + (let* ((channel (riece-get-channel name)) + (users (riece-channel-users channel))) + (setq user (riece-identity-assoc user users t)) + (if flag + (if user + (unless (memq ?v (cdr user)) + (setcdr user (cons ?v (cdr user)))) + (riece-channel-set-users channel (cons (list user ?v) users))) + (if user + (setcdr user (delq ?v (cdr user))))))) + +(provide 'riece-channel) + +;;; riece-channel.el ends here