12013e4531b123f2a3d0c170443c0c119fd9e060
[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             (set-window-point (get-buffer-window (current-buffer))
77                               (point)))
78         (run-hook-with-args 'riece-after-insert-functions start (point))))
79     (setq buffers (cdr buffers))))
80
81 (defun riece-insert-change (buffer message)
82   (riece-insert buffer (concat riece-change-prefix message)))
83
84 (defun riece-insert-notice (buffer message)
85   (riece-insert buffer (concat riece-notice-prefix message)))
86
87 (defun riece-insert-wallops (buffer message)
88   (riece-insert buffer (concat riece-wallops-prefix message)))
89
90 (defun riece-insert-error (buffer message)
91   (riece-insert buffer (concat riece-error-prefix message)))
92
93 (defun riece-insert-info (buffer message)
94   (riece-insert buffer (concat riece-info-prefix message)))
95
96 (defun riece-frozen (buffer)
97   (with-current-buffer buffer
98     riece-freeze))
99
100 (defun riece-own-frozen (buffer)
101   (with-current-buffer buffer
102     (eq riece-freeze 'own)))
103
104 (defun riece-channel-p (string)
105   "Return t if STRING is a channel.
106 \(i.e. it matches `riece-channel-regexp')"
107   (string-match (concat "^" riece-channel-regexp) string))
108
109 (defun riece-user-p (string)
110   "Return t if STRING is a user.
111 \(i.e. it matches `riece-user-regexp')"
112   (string-match (concat "^" riece-user-regexp) string))
113
114 (defun riece-current-nickname ()
115   "Return the current nickname."
116   (riece-with-server-buffer (riece-current-server-name)
117     (if riece-real-nickname
118         (riece-make-identity riece-real-nickname riece-server-name))))
119
120 (defun riece-split-parameters (string)
121   (if (eq ?: (aref string 0))
122       (list (substring string 1))
123     (let (parameters)
124       (catch 'done
125         (while (string-match "^\\([^ ]+\\) +" string)
126           (setq parameters (nconc parameters (list (match-string 1 string)))
127                 string (substring string (match-end 0)))
128           (when (and (not (equal "" string)) (eq ?: (aref string 0)))
129             (setq string (substring string 1)
130                   parameters (nconc parameters (list string)))
131             (throw 'done nil)))
132         (or (equal "" string)
133             (setq parameters (nconc parameters (list string)))))
134       parameters)))
135
136 (defun riece-concat-channel-topic (target string)
137   (riece-with-server-buffer (riece-identity-server target)
138     (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
139       (if (or (null topic)
140               (equal topic ""))
141           string
142         (concat string ": " topic)))))
143
144 (defun riece-concat-channel-modes (target string)
145   (riece-with-server-buffer (riece-identity-server target)
146     (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
147       (if modes
148           (concat string " ["
149                   (mapconcat
150                    (lambda (mode)
151                      (if (riece-mode-parameter mode)
152                          (format "%c(%s)"
153                                  (riece-mode-flag mode)
154                                  (riece-mode-parameter mode))
155                        (char-to-string (riece-mode-flag mode))))
156                    modes "")
157                   "]")
158         string))))
159
160 (defun riece-concat-message (string message)
161   (if (or (null message)
162           (equal message ""))
163       string
164     (concat string " (" message ")")))
165
166 (defun riece-concat-server-name (string)
167   (if (equal riece-server-name "")
168       string
169     (concat string " (from " riece-server-name ")")))
170
171 (defun riece-concat-user-status (status string)
172   (if status
173       (concat string " [" (mapconcat #'identity status ", ") "]")
174     string))
175
176 (defun riece-prefix-user-at-host (prefix)
177   (if (string-match "!" prefix)
178       (substring prefix (match-end 0))
179     prefix))
180
181 (defun riece-prefix-nickname (prefix)
182   (if (string-match "!" prefix)
183       (substring prefix 0 (match-beginning 0))
184     prefix))
185
186 (defun riece-parse-user-at-host (user-at-host)
187   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
188       (progn
189         (if (memq (aref user-at-host 0) '(?^ ?=))
190             (setq riece-user-at-host-type 'fake)
191           (if (memq (aref user-at-host 0) '(?~ ?-))
192               (setq riece-user-at-host-type 'not-verified)
193             (if (eq (aref user-at-host 0) ?+)
194                 (setq riece-user-at-host-type 'ok))))
195         (substring user-at-host 1))
196     (setq riece-user-at-host-type 'ok)
197     user-at-host))
198
199 (defun riece-strip-user-at-host (user-at-host)
200   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
201       (substring user-at-host 1)
202     user-at-host))
203
204 (defun riece-get-users-on-server (server-name)
205   (delq nil (mapcar (lambda (identity)
206                       (if (riece-user-p (riece-identity-prefix identity))
207                           identity))
208                     (riece-get-identities-on-server server-name))))
209
210 (defun riece-get-identities-on-server (server-name)
211   (riece-with-server-buffer server-name
212     (let (identities)
213       (mapatoms
214        (lambda (atom)
215          (setq identities
216                (cons (riece-make-identity (symbol-name atom) server-name)
217                      identities)))
218        riece-obarray)
219       identities)))
220
221 (defun riece-check-channel-commands-are-usable (&optional channel)
222    (unless riece-current-channel
223      (error (substitute-command-keys
224              "Type \\[riece-command-join] to join a channel")))
225    (if (and channel
226             (not (riece-channel-p (riece-identity-prefix
227                                    riece-current-channel))))
228        (error "Not on a channel")))
229
230 (provide 'riece-misc)
231
232 ;;; riece-misc.el ends here