543549ff44d938a044e6284f55eb30d6e6425b8a
[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 (require 'riece-mode)
35
36 (defun riece-get-buffer-create (name &optional init-major-mode)
37   (let ((buffer (get-buffer name)))
38     (unless (and buffer
39                  (or (null init-major-mode)
40                      (eq (with-current-buffer buffer
41                            major-mode)
42                          init-major-mode)))
43       (setq buffer (generate-new-buffer name)))
44     (unless (memq buffer riece-buffer-list)
45       (setq riece-buffer-list (cons buffer riece-buffer-list)))
46     buffer))
47
48 (defun riece-scan-property-region (property start end function)
49   (catch 'done
50     (while t
51       ;; Search for the beginning of the property region.
52       (unless (get-text-property start property)
53         (setq start (next-single-property-change start property nil end)))
54       (if (= start end)
55           (throw 'done nil))
56       ;; Search for the end of the property region.
57       (let ((region-end (next-single-property-change start property nil end)))
58         (if (= region-end end)
59             (throw 'done nil))
60         (funcall function start region-end)
61         (setq start region-end)))))
62
63 (defun riece-insert (buffers string)
64   (unless (listp buffers)
65     (setq buffers (list buffers)))
66   (while buffers
67     (run-hooks 'riece-before-insert-functions)
68     (save-excursion
69       (set-buffer (car buffers))
70       (let ((inhibit-read-only t)
71             buffer-read-only
72             (start (goto-char (point-max))))
73         (insert (format-time-string "%H:%M") " " string)
74         (if (and (not (riece-frozen (current-buffer)))
75                  (get-buffer-window (current-buffer)))
76             (recenter -1 (get-buffer-window (current-buffer))))
77         (run-hook-with-args 'riece-after-insert-functions start (point))))
78     (setq buffers (cdr buffers))))
79
80 (defun riece-insert-change (buffer message)
81   (riece-insert buffer (concat riece-change-prefix message)))
82
83 (defun riece-insert-notice (buffer message)
84   (riece-insert buffer (concat riece-notice-prefix message)))
85
86 (defun riece-insert-wallops (buffer message)
87   (riece-insert buffer (concat riece-wallops-prefix message)))
88
89 (defun riece-insert-error (buffer message)
90   (riece-insert buffer (concat riece-error-prefix message)))
91
92 (defun riece-insert-info (buffer message)
93   (riece-insert buffer (concat riece-info-prefix message)))
94
95 (defun riece-frozen (buffer)
96   (with-current-buffer buffer
97     riece-freeze))
98
99 (defun riece-own-frozen (buffer)
100   (with-current-buffer buffer
101     (eq riece-freeze 'own)))
102
103 (defun riece-channel-p (string)
104   "Return t if STRING is a channel.
105 \(i.e. it matches `riece-channel-regexp')"
106   (string-match (concat "^" riece-channel-regexp) string))
107
108 (defun riece-user-p (string)
109   "Return t if STRING is a user.
110 \(i.e. it matches `riece-user-regexp')"
111   (string-match (concat "^" riece-user-regexp) string))
112
113 (defun riece-current-nickname ()
114   "Return the current nickname."
115   (riece-with-server-buffer (riece-current-server-name)
116     (if riece-real-nickname
117         (riece-make-identity riece-real-nickname riece-server-name))))
118
119 (defun riece-split-parameters (string)
120   (if (eq ?: (aref string 0))
121       (list (substring string 1))
122     (let (parameters)
123       (catch 'done
124         (while (string-match "^\\([^ ]+\\) +" string)
125           (setq parameters (nconc parameters (list (match-string 1 string)))
126                 string (substring string (match-end 0)))
127           (when (and (not (equal "" string)) (eq ?: (aref string 0)))
128             (setq string (substring string 1)
129                   parameters (nconc parameters (list string)))
130             (throw 'done nil)))
131         (or (equal "" string)
132             (setq parameters (nconc parameters (list string)))))
133       parameters)))
134
135 (defun riece-concat-channel-topic (target string)
136   (riece-with-server-buffer (riece-identity-server target)
137     (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
138       (if (or (null topic)
139               (equal topic ""))
140           string
141         (concat string ": " topic)))))
142
143 (defun riece-concat-channel-modes (target string)
144   (riece-with-server-buffer (riece-identity-server target)
145     (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
146       (if modes
147           (concat string " ["
148                   (mapconcat
149                    (lambda (mode)
150                      (if (riece-mode-parameter mode)
151                          (format "%c(%s)"
152                                  (riece-mode-flag mode)
153                                  (riece-mode-parameter mode))
154                        (char-to-string (riece-mode-flag mode))))
155                    modes "")
156                   "]")
157         string))))
158
159 (defun riece-concat-message (string message)
160   (if (or (null message)
161           (equal message ""))
162       string
163     (concat string " (" message ")")))
164
165 (defun riece-concat-server-name (string)
166   (if (equal riece-server-name "")
167       string
168     (let ((server-name (concat " (from " riece-server-name ")")))
169       (put-text-property 0 (length server-name)
170                          'riece-server-name riece-server-name
171                          server-name)
172       (concat string server-name))))
173
174 (defun riece-concat-user-status (status string)
175   (if status
176       (concat string " [" (mapconcat #'identity status ", ") "]")
177     string))
178
179 (defun riece-prefix-user-at-host (prefix)
180   (if (string-match "!" prefix)
181       (substring prefix (match-end 0))
182     prefix))
183
184 (defun riece-prefix-nickname (prefix)
185   (if (string-match "!" prefix)
186       (substring prefix 0 (match-beginning 0))
187     prefix))
188
189 (defun riece-parse-user-at-host (user-at-host)
190   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
191       (progn
192         (if (memq (aref user-at-host 0) '(?^ ?=))
193             (setq riece-user-at-host-type 'fake)
194           (if (memq (aref user-at-host 0) '(?~ ?-))
195               (setq riece-user-at-host-type 'not-verified)
196             (if (eq (aref user-at-host 0) ?+)
197                 (setq riece-user-at-host-type 'ok))))
198         (substring user-at-host 1))
199     (setq riece-user-at-host-type 'ok)
200     user-at-host))
201
202 (defun riece-strip-user-at-host (user-at-host)
203   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
204       (substring user-at-host 1)
205     user-at-host))
206
207 (defun riece-get-users-on-server (server-name)
208   (delq nil (mapcar (lambda (identity)
209                       (if (riece-user-p (riece-identity-prefix identity))
210                           identity))
211                     (riece-get-identities-on-server server-name))))
212
213 (defun riece-get-identities-on-server (server-name)
214   (riece-with-server-buffer server-name
215     (let (identities)
216       (mapatoms
217        (lambda (atom)
218          (setq identities
219                (cons (riece-make-identity (symbol-name atom) server-name)
220                      identities)))
221        riece-obarray)
222       identities)))
223
224 (defun riece-check-channel-commands-are-usable (&optional channel)
225    (unless riece-current-channel
226      (error (substitute-command-keys
227              "Type \\[riece-command-join] to join a channel")))
228    (if (and channel
229             (not (riece-channel-p (riece-identity-prefix
230                                    riece-current-channel))))
231        (error "Not on a channel")))
232
233 (provide 'riece-misc)
234
235 ;;; riece-misc.el ends here