2ba578582ebb5c524ee57acebd84062785f8e4f4
[riece] / lisp / riece-misc.el
1 ;;; riece-misc.el --- miscellaneous functions (not inlined)
2 ;; Copyright (C) 1998-2003 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Created: 1998-09-28
6 ;; Keywords: IRC, riece
7
8 ;; This file is part of Riece.
9
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Code:
26
27 (require 'riece-options)
28 (require 'riece-coding)
29 (require 'riece-identity)
30 (require 'riece-version)
31 (require 'riece-channel)
32 (require 'riece-server)
33 (require 'riece-user)
34
35 (defun riece-get-buffer-create (name)
36   (let ((buffer (get-buffer-create name)))
37     (unless (memq buffer riece-buffer-list)
38       (setq riece-buffer-list (cons buffer riece-buffer-list)))
39     buffer))
40
41 (defun riece-insert (buffers string)
42   (unless (listp buffers)
43     (setq buffers (list buffers)))
44   (while buffers
45     (run-hooks 'riece-before-insert-functions)
46     (save-excursion
47       (set-buffer (riece-get-buffer-create (car buffers)))
48       (let ((inhibit-read-only t)
49             buffer-read-only
50             (start (goto-char (point-max))))
51         (insert (format-time-string "%H:%M") " " string)
52         (if (and (not (riece-frozen (current-buffer)))
53                  (get-buffer-window (current-buffer)))
54             (set-window-point (get-buffer-window (current-buffer))
55                               (point)))
56         (run-hook-with-args 'riece-after-insert-functions start (point))))
57     (setq buffers (cdr buffers))))
58
59 (defun riece-insert-change (buffer message)
60   (riece-insert buffer (concat riece-change-prefix message)))
61
62 (defun riece-insert-notice (buffer message)
63   (riece-insert buffer (concat riece-notice-prefix message)))
64
65 (defun riece-insert-wallops (buffer message)
66   (riece-insert buffer (concat riece-wallops-prefix message)))
67
68 (defun riece-insert-error (buffer message)
69   (riece-insert buffer (concat riece-error-prefix message)))
70
71 (defun riece-insert-info (buffer message)
72   (riece-insert buffer (concat riece-info-prefix message)))
73
74 (defun riece-frozen (buffer)
75   (with-current-buffer buffer
76     riece-freeze))
77
78 (defun riece-own-frozen (buffer)
79   (with-current-buffer buffer
80     (eq riece-freeze 'own)))
81
82 (defun riece-channel-p (string)
83   "Return t if STRING is a channel.
84 \(i.e. it matches `riece-channel-regexp')"
85   (string-match (concat "^" riece-channel-regexp) string))
86
87 (defun riece-current-nickname ()
88   "Return the current nickname."
89   (riece-with-server-buffer (riece-identity-server riece-current-channel)
90     (if riece-real-nickname
91         (riece-make-identity riece-real-nickname riece-server-name))))
92
93 (defun riece-split-parameters (string)
94   (if (eq ?: (aref string 0))
95       (list (substring string 1))
96     (let (parameters)
97       (catch 'done
98         (while (string-match "^\\([^ ]+\\) +" string)
99           (setq parameters (nconc parameters (list (match-string 1 string)))
100                 string (substring string (match-end 0)))
101           (and (not (equal "" string)) (eq ?: (aref string 0))
102                (setq string (substring string 1))
103                (throw 'done nil))))
104       (or (equal "" string)
105           (setq parameters (nconc parameters (list string))))
106       parameters)))
107
108 (defun riece-concat-channel-topic (target string)
109   (riece-with-server-buffer (riece-identity-server target)
110     (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
111       (if topic
112           (concat string ": " topic)
113         string))))
114
115 (defun riece-concat-channel-modes (target string)
116   (riece-with-server-buffer (riece-identity-server target)
117     (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
118       (if modes
119           (concat string " [" (apply #'string modes) "]")
120         string))))
121
122 (defun riece-concat-message (string message)
123   (if (or (null message)
124           (equal message ""))
125       string
126     (concat string " (" message ")")))
127
128 (defun riece-concat-server-name (string)
129   (if (equal riece-server-name "")
130       string
131     (concat string " (from " riece-server-name ")")))
132
133 (defun riece-prefix-user-at-host (prefix)
134   (if (string-match "!" prefix)
135       (substring prefix (match-end 0))
136     prefix))
137
138 (defun riece-prefix-nickname (prefix)
139   (if (string-match "!" prefix)
140       (substring prefix 0 (match-beginning 0))
141     prefix))
142
143 (defun riece-parse-user-at-host (user-at-host)
144   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
145       (progn
146         (if (memq (aref user-at-host 0) '(?^ ?=))
147             (setq riece-user-at-host-type 'fake)
148           (if (memq (aref user-at-host 0) '(?~ ?-))
149               (setq riece-user-at-host-type 'not-verified)
150             (if (eq (aref user-at-host 0) ?+)
151                 (setq riece-user-at-host-type 'ok))))
152         (substring user-at-host 1))
153     (setq riece-user-at-host-type 'ok)
154     user-at-host))
155
156 (defun riece-strip-user-at-host (user-at-host)
157   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
158       (substring user-at-host 1)
159     user-at-host))
160
161 (defun riece-get-users-on-server ()
162   (riece-with-server-buffer (riece-identity-server riece-current-channel)
163     (let (users)
164       (mapatoms
165        (lambda (atom)
166          (unless (riece-channel-p (symbol-name atom))
167            (setq users (cons (symbol-name atom) users))))
168        riece-obarray)
169       (if (member riece-real-nickname users)
170           users
171         (cons riece-real-nickname users)))))
172
173 (provide 'riece-misc)
174
175 ;;; riece-misc.el ends here