1 ;;; liece-nick.el --- Various facility for nick 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 (require 'liece-hilit)
36 (defalias 'liece-nick-set-operator 'liece-channel-set-operator)
37 (defalias 'liece-nick-set-voice 'liece-channel-set-voice)
38 (defun liece-nick-equal (n1 n2)
39 (string-equal-ignore-case n1 n2))
41 (defun liece-nick-member (nick nicks)
42 "Return non-nil if NICK is member of NICKS."
45 (and (stringp item) (liece-nick-equal nick item)))
48 (defvar liece-nick-insert-hook nil)
49 (defvar liece-nick-replace-hook nil)
51 (define-widget 'liece-nick-push-button 'push-button
53 :action 'liece-nick-popup-menu)
55 (defcustom liece-nick-sort-nicks nil
56 "If t, sort nick list in each time."
60 (defcustom liece-nick-sort-predicate 'string-lessp
61 "Function for sorting nick buffers."
65 ;;; Nick status functions
66 (defun liece-nick-get-joined-channels (nick)
67 "Return channels as list NICK is joined."
68 (get (intern (or nick liece-real-nickname) liece-obarray) 'join))
70 (defun liece-nick-get-user-at-host (nick)
71 "Return user-at-host as string NICK is joined."
72 (get (intern (or nick liece-real-nickname) liece-obarray) 'user-at-host))
74 (defun liece-nick-set-user-at-host (nick user-at-host)
75 "Set user at host as string NICK is joined."
76 (put (intern (or nick liece-real-nickname) liece-obarray)
77 'user-at-host user-at-host))
79 (defun liece-nick-mark-as-part (part &optional nick)
80 "Mark NICK is temporary apart."
81 (put (intern (or nick liece-real-nickname) liece-obarray) 'part part))
83 (defun liece-nick-get-modes (&optional nick)
84 "Return modes as string NICK is joined."
85 (get (intern (or nick liece-real-nickname) liece-obarray) 'mode))
87 (defun liece-nick-add-mode (mode &optional nick)
88 "Add MODE as char to NICK.
89 MODE is a string splitted into characters one by one."
92 (or (liece-nick-get-modes nick) ""))))
95 (put (intern (or nick liece-real-nickname) liece-obarray)
96 'mode (mapconcat #'char-to-string modes ""))))
98 (defun liece-nick-remove-mode (mode &optional nick)
99 "Remove MODE from NICK.
100 MODE is a string splitted into characters one by one."
102 (liece-string-to-list
103 (or (liece-nick-get-modes nick) ""))))
105 (put (intern (or nick liece-real-nickname) liece-obarray)
106 'mode (mapconcat #'char-to-string modes ""))))
108 (defun liece-nick-set-mode (nick mode toggle)
109 "Add or remove channel MODE of NICK.
110 MODE is a string splitted into characters one by one.
111 If FLAG is non-nil, given modes are added to the user.
112 Otherwise they are removed from the user."
114 (liece-nick-add-mode mode nick)
115 (liece-nick-remove-mode mode nick)))
117 (defmacro liece-nick-strip (nick)
118 `(if (and ,nick (memq (aref ,nick 0) '(?@ ?+ ? )))
122 (defmacro liece-nick-normalize (nick)
123 `(if (and ,nick (memq (aref ,nick 0) '(?@ ?+ ? )))
129 (defun liece-nick-insert (nick)
130 ;; Find sorted position
132 ((and (eq liece-nick-sort-nicks t)
133 (liece-functionp liece-nick-sort-predicate))
135 (goto-char (point-min))
136 (while (and (not (eobp)) (not found))
137 (if (condition-case nil
138 (funcall liece-nick-sort-predicate
139 (liece-nick-strip nick)
140 (widget-value (widget-at (1+ (point)))))
143 (beginning-of-line 2)))))
144 ((eq liece-nick-sort-nicks 'reverse)
145 (goto-char (point-min)))
146 (t (goto-char (point-max))))
148 (insert (substring nick 0 1))
149 (let ((st (point)) (nick (liece-nick-strip nick)))
151 (when liece-highlight-mode
152 (liece-widget-convert-button
153 'liece-nick-push-button st (point) nick))
155 (run-hook-with-args 'liece-nick-insert-hook st (point))))
157 (defun liece-nick-replace (old new &optional limit regexp)
159 (setq old (concat "^\\(" old "\\)$"))
160 (setq old (concat "^\\([ @+]\\)\\(" (regexp-quote old) "\\)$")))
161 (let (case-fold-search beg end)
162 (when (re-search-forward old limit t)
164 (setq new (concat (match-string 1) new)))
165 (if (and (eq liece-nick-sort-nicks t)
166 (liece-functionp liece-nick-sort-predicate))
168 (delete-region (match-beginning 0)
169 (progn (goto-char (match-end 0))
170 (forward-char) (point)))
171 (liece-nick-insert new))
173 (widget-delete (widget-at (1+ (point))))
175 (replace-match new t t)
177 beg (progn (beginning-of-line) (1+ (point))))
178 (when liece-highlight-mode
179 (liece-widget-convert-button
180 'liece-nick-push-button beg end (substring new 1)))
181 (run-hook-with-args 'liece-nick-replace-hook beg end)))))
184 (defun liece-command-toggle-nick-buffer-mode ()
186 (when (and (eq liece-command-buffer-mode 'channel)
187 (get-buffer liece-nick-buffer))
188 (setq liece-nick-buffer-mode (not liece-nick-buffer-mode)))
189 (liece-configure-windows))
191 (defun liece-nick-buffer-create (chnl)
193 (liece-get-buffer-create (format liece-nick-buffer-format chnl))
194 (unless (eq major-mode 'liece-nick-mode)
196 (set-alist 'liece-nick-buffer-alist chnl (current-buffer))
199 (defun liece-change-nick-of-1 (old new nicks)
201 (do ((nicks nicks (cdr nicks)))
203 (if (liece-nick-equal (caar nicks) old)
204 (setcar (car nicks) new))))
207 `(lambda (nick) (liece-nick-equal (car nick) ,old))
210 (defun liece-change-nick-of-2 (old new nicks)
212 (do ((nicks nicks (cdr nicks)))
214 (if (liece-nick-equal (car nicks) old)
215 (setcar nicks new))))
218 `(lambda (nick) (liece-nick-equal nick ,old))
221 (defun liece-change-nick-of (old new)
222 (liece-change-nick-of-1 old new liece-nick-alist)
223 (let ((chnls (liece-nick-get-joined-channels old)))
225 (liece-change-nick-of-2 old new (liece-channel-get-nicks chnl))
226 (liece-change-nick-of-2 old new (liece-channel-get-operators chnl))
227 (liece-change-nick-of-2 old new (liece-channel-get-voices chnl)))))
229 (defmacro liece-nick-join-1 (user chnl)
230 "Add CHNL to list of channels USER belongs to."
231 `(let* ((flag (string-to-char user))
232 (user (liece-nick-strip ,user))
233 (u (intern user liece-obarray))
234 (c (intern ,chnl liece-obarray)))
235 (or (string-assoc-ignore-case user liece-nick-alist)
236 (push (list user) liece-nick-alist))
238 ((char-equal flag ?@)
239 (liece-channel-set-operator ,chnl user t))
240 ((char-equal flag ?+)
241 (liece-channel-set-voice ,chnl user t)))
242 (or (string-list-member-ignore-case ,chnl (get u 'join))
243 (put u 'join (cons ,chnl (get u 'join))))
244 (or (string-list-member-ignore-case user (get c 'nick))
245 (put c 'nick (cons user (get c 'nick))))))
247 (defmacro liece-nick-part-1 (user chnl)
248 "Remove USER information from his CHNL."
249 `(let ((u (intern ,user liece-obarray))
250 (c (intern ,chnl liece-obarray)))
251 (liece-channel-set-operator ,chnl ,user nil)
252 (liece-channel-set-voice ,chnl ,user nil)
253 (put u 'join (string-list-remove-ignore-case ,chnl (get u 'join)))
254 (put c 'nick (string-list-remove-ignore-case ,user (get c 'nick)))))
257 (defun liece-nick-join (user chnl)
258 (liece-nick-join-1 user chnl)
259 (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
260 (with-current-buffer nbuf
261 (let (buffer-read-only)
262 (liece-nick-insert (liece-nick-normalize user))))))
265 (defun liece-nick-part (user chnl)
266 (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
267 (setq user (liece-nick-strip user))
268 (with-current-buffer nbuf
269 (let ((case-fold-search t) buffer-read-only)
270 (goto-char (point-min))
271 (when (re-search-forward (concat "^." (regexp-quote user) "$") nil t)
272 (delete-region (match-beginning 0)
273 (progn (goto-char (match-end 0))
274 (forward-char) (point)))
275 (liece-nick-part-1 user chnl))))))
278 (defun liece-nick-change (old new)
279 (let* ((old (liece-nick-strip old)) (new (liece-nick-strip new))
280 (chnls (get (intern old liece-obarray) 'join)) chnl nbuf)
281 (liece-change-nick-of old new)
283 (put (intern new liece-obarray) 'join chnls))
284 (unintern old liece-obarray)
287 (liece-nick-part old chnl)
288 (setq nbuf (cdr (string-assoc-ignore-case
289 chnl liece-nick-buffer-alist)))
290 (with-current-buffer nbuf
291 (let (buffer-read-only)
292 (goto-char (point-min))
293 (liece-nick-replace old new)))))))
296 (defun liece-nick-update (chnl users)
297 (let ((c (intern chnl liece-obarray))
298 (nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
299 (mapcar (lambda (prop) (put c prop nil)) '(nick oper voice))
300 (with-current-buffer nbuf
301 (let (buffer-read-only)
302 (liece-kill-all-overlays)
304 (when (and liece-nick-sort-nicks
305 (liece-functionp liece-nick-sort-predicate))
306 (setq users (sort users
308 (funcall liece-nick-sort-predicate
309 (liece-nick-strip s1)
310 (liece-nick-strip s2))))))
311 (let (liece-nick-sort-predicate)
313 (liece-nick-join user chnl)))))
315 (defvar liece-nick-region-nicks nil)
318 (defun liece-nick-update-region ()
319 (setq liece-nick-region-nicks nil)
322 (if (not (region-active-p))
323 (setq region (cons (line-beginning-position)
324 (line-beginning-position 2)))
325 (setq region (cons (region-beginning) (region-end)))
326 (goto-char (car region))
327 (setcar region (line-beginning-position))
328 (goto-char (cdr region))
330 (setcdr region (line-beginning-position))
331 (setcdr region (line-beginning-position 2))))
333 (narrow-to-region (car region) (cdr region))
334 (goto-char (point-min))
336 (setq nick (widget-value (widget-at (1+ (point)))))
337 (push nick liece-nick-region-nicks)
338 (beginning-of-line 2))))))
340 (defun liece-nick-add-buttons (start end)
343 (while (re-search-forward
345 (concat "^\\(" liece-time-prefix-regexp "\\)?"
346 "[][=<>(][][=<>(]?\\([^:]*:\\)?\\([^][=<>(]+\\)"))
348 (let* ((nick-start (match-beginning 3))
349 (nick-end (match-end 3))
350 (nick (buffer-substring nick-start nick-end)))
351 (when liece-highlight-mode
352 (liece-widget-convert-button
353 'liece-nick-push-button nick-start nick-end nick))))))
356 (defun liece-nick-redisplay-buffer (chnl)
358 (cdr (string-assoc-ignore-case
359 chnl liece-nick-buffer-alist)))
360 (window (liece-get-buffer-window liece-nick-buffer)))
362 (with-current-buffer buffer
363 (set-window-buffer window buffer)
364 (unless (liece-frozen buffer)
365 (set-window-start window (point-min)))
366 (setq liece-nick-buffer buffer)))))
368 (provide 'liece-nick)
370 ;;; liece-nick.el ends here