1 ;;; liece-channel.el --- Various facility for channel operation.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: IRC, liece
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'liece-inlines))
34 (eval-when-compile (require 'liece-clfns))
36 (defconst liece-channel-regexp "[+&#!]")
37 (defconst liece-channel-modeless-regexp "[+!]")
39 (defvar liece-default-channel-representation-format "%s+%s")
41 (defconst liece-dcc-channel-representation-format "=%s")
43 (define-widget 'liece-channel-push-button 'push-button
45 :action 'liece-channel-push-button-action)
47 (defun liece-channel-push-button-action (widget &optional event)
48 (let ((chnl (liece-channel-virtual (widget-value widget))))
49 (if (or (liece-channel-member chnl liece-current-channels)
50 (y-or-n-p (format "Do you really join %s? " chnl)))
51 (liece-command-join chnl))))
53 ;;; Reader conventions
54 (defun liece-channel-p (chnl)
57 (concat "^" liece-channel-regexp))
60 (defun liece-channel-modeless-p (chnl)
63 (concat "^" liece-channel-modeless-regexp))
66 (defalias 'liece-channel-equal 'string-equal-ignore-case)
68 (defun liece-channel-member (chnl chnls)
69 "Return non-nil if CHNL is member of CHNLS."
72 (and (stringp item) (liece-channel-equal chnl item)))
75 (defun liece-channel-unread-p (chnl)
76 "Return non-nil if CHNL is unread channel."
79 (and (stringp item) (liece-channel-equal chnl item)))
80 liece-channel-unread-list))
82 (defun liece-channel-get-nicks (&optional chnl)
83 "Return CHNL or current channels's members as list."
84 (get (intern (or chnl liece-current-channel) liece-obarray) 'nick))
86 (defun liece-channel-get-operators (&optional chnl)
87 "Return CHNL or current channels's operators as list."
88 (get (intern (or chnl liece-current-channel) liece-obarray) 'oper))
90 (defun liece-channel-get-voices (&optional chnl)
91 "Return CHNL or current channels's voices as list."
92 (get (intern (or chnl liece-current-channel) liece-obarray) 'voice))
94 (defun liece-channel-get-topic (&optional chnl)
95 "Return CHNL or current channels's topic."
96 (get (intern (or chnl liece-current-channel) liece-obarray) 'topic))
98 (defun liece-channel-get-modes (&optional chnl)
99 "Return CHNL or current channels's mode."
100 (get (intern (or chnl liece-current-channel) liece-obarray)
103 (defun liece-channel-get-bans (&optional chnl)
104 "Return CHNL or current channels's ban list."
105 (get (intern (or chnl liece-current-channel) liece-obarray)
108 (defun liece-channel-get-invites (&optional chnl)
109 "Return CHNL or current channels's invite list."
110 (get (intern (or chnl liece-current-channel) liece-obarray)
113 (defun liece-channel-get-exceptions (&optional chnl)
114 "Return CHNL or current channels's exception list."
115 (get (intern (or chnl liece-current-channel) liece-obarray)
118 ;;; Internal functions
119 (defun liece-channel-remove (chnl chnls)
120 "Remove CHNL from CHNLS."
123 (and (stringp item) (liece-channel-equal chnl item)))
126 (defun liece-channel-delete (chnl chnls)
127 "Delete CHNL from CHNLS."
130 (and (stringp item) (liece-channel-equal chnl item)))
133 (defmacro liece-channel-set-topic (topic &optional chnl)
134 "Set CHNL or current channels's topic."
135 `(put (intern (or ,chnl liece-current-channel) liece-obarray)
138 (defmacro liece-channel-add-mode (mode &optional chnl)
139 "Add MODE as char to CHNL."
140 `(let ((modes (string-to-char-list (or (liece-channel-get-modes ,chnl)
142 (pushnew ,mode modes)
143 (put (intern (or ,chnl liece-current-channel) liece-obarray)
144 'mode (mapconcat #'char-to-string modes ""))))
146 (defmacro liece-channel-remove-mode (mode &optional chnl)
147 "Remove MODE as char to CHNL."
148 `(let ((modes (string-to-char-list (or (liece-channel-get-modes ,chnl)
151 (put (intern (or ,chnl liece-current-channel) liece-obarray)
152 'mode (mapconcat #'char-to-string modes ""))))
154 (defmacro liece-channel-set-mode (val mode &optional chnl)
155 "Set character VAL as channel MODE into the CHNL."
157 (liece-channel-add-mode ,mode ,chnl)
158 (liece-channel-remove-mode ,mode ,chnl)))
160 (defmacro liece-channel-add-ban (pattern &optional chnl)
161 "Add ban PATTERN as char to CHNL."
162 `(let ((patterns (liece-channel-get-bans ,chnl)))
163 (add-to-list 'patterns ,pattern)
164 (put (intern (or ,chnl liece-current-channel) liece-obarray)
167 (defmacro liece-channel-remove-ban (pattern &optional chnl)
168 "Remove ban PATTERN as char to CHNL."
169 `(let ((patterns (remove-if (lambda (elm) (string-equal ,pattern elm))
170 (liece-channel-get-bans ,chnl))))
171 (put (intern (or ,chnl liece-current-channel) liece-obarray)
174 (defmacro liece-channel-set-ban (chnl pattern val)
175 "Set ban PATTERN as char to CHNL."
177 (liece-channel-add-ban ,pattern ,chnl)
178 (liece-channel-remove-ban ,pattern ,chnl)))
180 (defmacro liece-channel-add-exception (pattern &optional chnl)
181 "Add exception PATTERN as char to CHNL."
182 `(let ((patterns (liece-channel-get-exceptions ,chnl)))
183 (pushnew ,pattern patterns)
184 (put (intern (or ,chnl liece-current-channel) liece-obarray)
185 'exception patterns)))
187 (defmacro liece-channel-remove-exception (pattern &optional chnl)
188 "Remove exception PATTERN as char to CHNL."
189 `(let ((patterns (remove-if (lambda (elm) (string-equal ,pattern elm))
190 (liece-channel-get-exceptions ,chnl))))
191 (put (intern (or ,chnl liece-current-channel) liece-obarray)
192 'exception patterns)))
194 (defmacro liece-channel-set-exception (chnl pattern val)
195 "Set exception PATTERN as char to CHNL."
197 (liece-channel-add-exception ,pattern ,chnl)
198 (liece-channel-remove-exception ,pattern ,chnl)))
200 (defmacro liece-channel-add-invite (pattern &optional chnl)
201 "Add invite PATTERN as char to CHNL."
202 `(let ((patterns (liece-channel-get-invites ,chnl)))
203 (pushnew ,pattern patterns)
204 (put (intern (or ,chnl liece-current-channel) liece-obarray)
207 (defmacro liece-channel-remove-invite (pattern &optional chnl)
208 "Remove invite PATTERN as char to CHNL."
209 `(let ((patterns (remove-if (lambda (elm) (string-equal ,pattern elm))
210 (liece-channel-get-invites ,chnl))))
211 (put (intern (or ,chnl liece-current-channel) liece-obarray)
214 (defmacro liece-channel-set-invite (chnl pattern val)
215 "Set invite PATTERN as char to CHNL."
217 (liece-channel-add-invite ,pattern ,chnl)
218 (liece-channel-remove-invite ,pattern ,chnl)))
220 (defun liece-channel-virtual (chnl)
221 "Convert channel name into internal representation.
222 \(For example if CHNL is a string \"#...:*\", it will be converted into
224 (let ((mapping liece-channel-conversion-map) match)
226 (if (string-equal-ignore-case (caar mapping) chnl)
227 (setq match (cdar mapping)))
233 ((and (string-match "^[#+]\\(.*\\):\\(.*\\)$" chnl)
234 (string= (match-string 2 chnl)
235 liece-channel-conversion-default-mask))
236 (if (eq ?+ (aref chnl 0))
237 (concat "-" (match-string 1 chnl))
238 (concat "%" (match-string 1 chnl))))
239 ((string= "" chnl) chnl)
240 ; ((eq ?! (aref chnl 0))
241 ; (concat "!" (substring chnl (1+ liece-channel-id-length))))
244 (defun liece-channel-real (chnl)
245 "Convert channel name into external representation.
246 \(For example if CHNL is a string \"%...\", it will be converted into
248 (let ((mapping liece-channel-conversion-map) match)
250 (if (string-equal-ignore-case (cdar mapping) chnl)
251 (setq match (caar mapping)))
255 ((eq ?% (aref chnl 0))
256 (concat "#" (substring chnl 1) ":"
257 liece-channel-conversion-default-mask))
258 ((eq ?- (aref chnl 0))
259 (concat "+" (substring chnl 1) ":"
260 liece-channel-conversion-default-mask))
264 (defun liece-command-toggle-channel-buffer-mode ()
265 "Toggle visibility of channel buffer."
267 (if (get-buffer liece-channel-buffer)
268 (setq liece-channel-buffer-mode (not liece-channel-buffer-mode)))
269 (liece-configure-windows))
271 (defmacro liece-channel-buffer-create (chnl)
272 "Create channel buffer of CHNL."
273 `(with-current-buffer
274 (liece-get-buffer-create (format liece-channel-buffer-format ,chnl))
275 (let (buffer-read-only)
276 (liece-insert-info (current-buffer)
277 (concat (funcall liece-format-time-function
280 (unless (eq major-mode 'liece-channel-mode)
281 (liece-channel-mode))
282 (set-alist 'liece-channel-buffer-alist ,chnl (current-buffer))
285 (defun liece-channel-join-internal (item chnls &optional hints)
286 (let (binding inserted)
287 (if (liece-channel-member item hints)
288 (do ((hint hints (cdr hint)) (chnl chnls (cdr chnl)))
289 ((not (or hint chnl)))
290 (if (and (car hint) (liece-channel-equal (car hint) item))
292 (push (car chnl) binding)))
293 (do ((hint hints (cdr hint)) (chnl chnls (cdr chnl)))
294 ((not (or hint chnl)))
295 (if (and (not inserted)
296 (not (or (car hint) (car chnl))))
300 (push (car chnl) binding))))
301 (or (liece-channel-member item binding)
305 (defun liece-channel-join (chnl &optional nosw)
306 "Initialize channel variables of CHNL.
307 If NOSW is non-nil do not switch to newly created channel."
308 (let ((cbuf (cdr (string-assoc-ignore-case chnl liece-channel-buffer-alist)))
309 (nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
311 (setq cbuf (liece-channel-buffer-create chnl)))
313 (setq nbuf (liece-nick-buffer-create chnl)))
314 (if (liece-channel-p (liece-channel-real chnl))
315 (setq liece-current-channels
316 (liece-channel-join-internal
317 chnl liece-current-channels liece-default-channel-binding))
318 (setq liece-current-chat-partners
319 (liece-channel-join-internal chnl liece-current-chat-partners
320 liece-default-partner-binding)))
322 (liece-switch-to-channel chnl)
323 (setq liece-channel-buffer cbuf
324 liece-nick-buffer nbuf))
325 (liece-channel-change)))
327 (defun liece-channel-part-internal (item chnls &optional hints)
331 (if (and chnl (liece-channel-equal item chnl)) nil chnl))
333 (liece-channel-remove item chnls)))
335 (defun liece-channel-part (chnl &optional nosw)
336 "Finalize channel variables of CHNL.
337 If NOSW is non-nil do not switch to newly created channel."
339 ((eq liece-command-buffer-mode 'chat)
340 (setq liece-current-chat-partners
341 (liece-channel-part-internal chnl liece-current-chat-partners
342 liece-default-partner-binding))
344 (liece-channel-switch-to-last liece-current-chat-partners)))
346 (setq liece-current-channels
347 (liece-channel-part-internal chnl liece-current-channels
348 liece-default-channel-binding))
350 (liece-channel-switch-to-last liece-current-channels)))))
352 (defun liece-channel-last (chnls)
353 (car (last (delq nil (copy-sequence chnls)))))
355 (defmacro liece-channel-switch-to-last (chnls)
356 `(let ((chnl (liece-channel-last ,chnls)))
358 (liece-switch-to-channel chnl))
359 (liece-channel-change)))
361 (defun liece-channel-change ()
362 (let ((chnls (if (eq liece-command-buffer-mode 'chat)
363 liece-current-chat-partners
364 liece-current-channels))
367 (with-current-buffer liece-channel-list-buffer
368 (let ((n 1) buffer-read-only)
372 (setq chnl (liece-channel-virtual chnl)
373 string (format "%s,%d:%s" string n chnl))
374 (liece-channel-list-add-button n chnl))
376 (if (string-equal string "")
377 (if (eq liece-command-buffer-mode 'chat)
378 (setq liece-channels-indicator "No partner")
379 (setq liece-channels-indicator "No channel"))
380 (setq liece-channels-indicator (substring string 1)))
381 (liece-set-channel-indicator)
382 (setq chnl (if (eq liece-command-buffer-mode 'chat)
383 liece-current-chat-partner
384 liece-current-channel))
387 (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
388 (liece-configure-windows)))
390 (defsubst liece-channel-set-operator-1 (chnl user val)
391 (let* ((chnl (intern chnl liece-obarray)) (opers (get chnl 'oper)))
393 (or (string-list-member-ignore-case user opers)
394 (put chnl 'oper (cons user opers)))
395 (if (string-list-member-ignore-case user opers)
396 (put chnl 'oper (string-list-remove-ignore-case user opers))))))
398 (defsubst liece-channel-set-voice-1 (chnl user val)
399 (let* ((chnl (intern chnl liece-obarray)) (voices (get chnl 'voice)))
401 (or (string-list-member-ignore-case user voices)
402 (put chnl 'voice (cons user voices)))
403 (if (string-list-member-ignore-case user voices)
404 (put chnl 'voice (string-list-remove-ignore-case user voices))))))
406 (defun liece-channel-set-operator (chnl user val)
407 (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist)))
409 (liece-channel-set-operator-1 chnl user val)
410 (liece-channel-set-voice-1 chnl user val)
411 (setq user (concat (if val "@" " ") user)
412 xuser (concat (if val "[ +]" "@") (regexp-quote xuser)))
413 (with-current-buffer nbuf
414 (let (buffer-read-only)
415 (goto-char (point-min))
416 (liece-nick-replace xuser user nil t)))))
418 (defun liece-channel-set-voice (chnl user val)
419 (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist)))
421 (liece-channel-set-voice-1 chnl user val)
422 (setq user (concat (if val "+" " ") user)
423 xuser (concat (if val " " "\\+") (regexp-quote xuser)))
424 (with-current-buffer nbuf
425 (let (buffer-read-only)
426 (goto-char (point-min))
427 (liece-nick-replace xuser user nil t)))))
429 (defun liece-channel-prepare-partner (join-channel-var)
430 (setq liece-current-chat-partner
431 (or liece-current-chat-partner join-channel-var))
432 (let ((liece-command-buffer-mode 'chat))
433 (liece-channel-join join-channel-var t))
434 (liece-channel-change))
436 (defun liece-channel-buffer-invisible-p (chnl mode)
437 (let ((cbuf (liece-pick-buffer chnl)))
438 (or (liece-frozen (car cbuf))
440 (not (and (eq liece-command-buffer-mode 'chat)
441 liece-current-chat-partner
442 (string-equal-ignore-case
443 chnl liece-current-chat-partner))))
444 (not (and (eq liece-command-buffer-mode 'channel)
445 liece-current-channel
446 (string-equal-ignore-case
447 chnl liece-current-channel))))))
449 (defun liece-channel-prepare-representation (chnl &optional method name)
452 (format liece-dcc-channel-representation-format chnl))
454 (format liece-default-channel-representation-format name chnl))
457 (defun liece-channel-parse-representation (str)
461 (regexp-quote liece-dcc-channel-representation-format)
464 (vector 'dcc nil (match-string 1 str)))
467 (regexp-quote liece-default-channel-representation-format)
468 "\\([^ ]+\\)" "\\([^ ]+\\)")
470 (vector 'irc (match-string 1 str) (match-string 2 str)))
471 (t (vector 'irc nil str))))
473 (defun liece-channel-list-add-button (n chnl)
474 (insert (format "%2d: " n))
475 (if liece-highlight-mode
478 (liece-widget-convert-button
479 'liece-channel-push-button st (point) chnl))
483 (defun liece-channel-add-buttons (start end)
486 (while (re-search-forward
488 (concat "\\(^\\(" liece-time-prefix-regexp "\\)?"
489 "[][=<>(-][][=<>(-]?\\|\\s-+[+@]?\\)"
490 "\\([&#!%][^ :]*\\)"))
492 ;;(re-search-forward "\\s-+\\(\\)\\([-+]\\S-*\\)" end t)
493 (let* ((chnl-start (match-beginning 3))
494 (chnl-end (match-end 3))
495 (chnl (buffer-substring chnl-start chnl-end)))
496 (when liece-highlight-mode
497 (liece-widget-convert-button
498 'liece-channel-push-button chnl-start chnl-end chnl))))))
501 (defun liece-channel-redisplay-buffer (chnl)
503 (cdr (string-assoc-ignore-case
504 chnl liece-channel-buffer-alist)))
505 (window (liece-get-buffer-window liece-channel-buffer)))
506 (and (liece-channel-unread-p chnl)
507 (setq liece-channel-unread-list
508 (delete chnl liece-channel-unread-list)))
510 (with-current-buffer buffer
511 (set-window-buffer window buffer)
512 (unless (liece-frozen buffer)
513 (set-window-point window (point-max)))
514 (setq liece-channel-buffer buffer)))))
517 (defun liece-channel-list-redisplay-buffer (chnl)
518 (let ((window (liece-get-buffer-window liece-channel-list-buffer)))
520 (save-selected-window
521 (select-window window)
522 (goto-char (point-min))
523 (search-forward chnl nil t)
524 (set-window-point window (match-beginning 0))
525 (when liece-highlight-mode
526 (let ((overlay (make-overlay (point)(match-end 0))))
529 (if (overlay-get ovl 'liece-channel)
530 (delete-overlay ovl))))
531 (overlay-put overlay 'face 'underline)
532 (overlay-put overlay 'liece-channel t)))))))
534 (provide 'liece-channel)
536 ;;; liece-channel.el ends here