1 ;;; riece-misc.el --- miscellaneous functions (not inlined)
2 ;; Copyright (C) 1998-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
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)
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.
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.
27 (require 'riece-options)
28 (require 'riece-coding)
29 (require 'riece-identity)
30 (require 'riece-version)
31 (require 'riece-channel)
32 (require 'riece-server)
35 (defun riece-get-buffer-create (name &optional init-major-mode)
36 (let ((buffer (get-buffer name)))
38 (or (null init-major-mode)
39 (eq (with-current-buffer buffer
42 (setq buffer (generate-new-buffer name)))
43 (unless (memq buffer riece-buffer-list)
44 (setq riece-buffer-list (cons buffer riece-buffer-list)))
47 (defun riece-scan-property-region (property start end function)
50 ;; Search for the beginning of the property region.
51 (unless (get-text-property start property)
52 (setq start (next-single-property-change start property nil end)))
55 ;; Search for the end of the property region.
56 (let ((region-end (next-single-property-change start property nil end)))
57 (if (= region-end end)
59 (funcall function start region-end)
60 (setq start region-end)))))
62 (defun riece-insert (buffers string)
63 (unless (listp buffers)
64 (setq buffers (list buffers)))
66 (run-hooks 'riece-before-insert-functions)
68 (set-buffer (car buffers))
69 (let ((inhibit-read-only t)
71 (start (goto-char (point-max))))
72 (insert (format-time-string "%H:%M") " " string)
73 (if (and (not (riece-frozen (current-buffer)))
74 (get-buffer-window (current-buffer)))
75 (set-window-point (get-buffer-window (current-buffer))
77 (run-hook-with-args 'riece-after-insert-functions start (point))))
78 (setq buffers (cdr buffers))))
80 (defun riece-insert-change (buffer message)
81 (riece-insert buffer (concat riece-change-prefix message)))
83 (defun riece-insert-notice (buffer message)
84 (riece-insert buffer (concat riece-notice-prefix message)))
86 (defun riece-insert-wallops (buffer message)
87 (riece-insert buffer (concat riece-wallops-prefix message)))
89 (defun riece-insert-error (buffer message)
90 (riece-insert buffer (concat riece-error-prefix message)))
92 (defun riece-insert-info (buffer message)
93 (riece-insert buffer (concat riece-info-prefix message)))
95 (defun riece-frozen (buffer)
96 (with-current-buffer buffer
99 (defun riece-own-frozen (buffer)
100 (with-current-buffer buffer
101 (eq riece-freeze 'own)))
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))
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))
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))))
119 (defun riece-split-parameters (string)
120 (if (eq ?: (aref string 0))
121 (list (substring string 1))
124 (while (string-match "^\\([^ ]+\\) +" string)
125 (setq parameters (nconc parameters (list (match-string 1 string)))
126 string (substring string (match-end 0)))
127 (and (not (equal "" string)) (eq ?: (aref string 0))
128 (setq string (substring string 1))
130 (or (equal "" string)
131 (setq parameters (nconc parameters (list string))))
134 (defun riece-concat-channel-topic (target string)
135 (riece-with-server-buffer (riece-identity-server target)
136 (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
140 (concat string ": " topic)))))
142 (defun riece-concat-channel-modes (target string)
143 (riece-with-server-buffer (riece-identity-server target)
144 (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
146 (concat string " [" (apply #'string modes) "]")
149 (defun riece-concat-message (string message)
150 (if (or (null message)
153 (concat string " (" message ")")))
155 (defun riece-concat-server-name (string)
156 (if (equal riece-server-name "")
158 (concat string " (from " riece-server-name ")")))
160 (defun riece-prefix-user-at-host (prefix)
161 (if (string-match "!" prefix)
162 (substring prefix (match-end 0))
165 (defun riece-prefix-nickname (prefix)
166 (if (string-match "!" prefix)
167 (substring prefix 0 (match-beginning 0))
170 (defun riece-parse-user-at-host (user-at-host)
171 (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
173 (if (memq (aref user-at-host 0) '(?^ ?=))
174 (setq riece-user-at-host-type 'fake)
175 (if (memq (aref user-at-host 0) '(?~ ?-))
176 (setq riece-user-at-host-type 'not-verified)
177 (if (eq (aref user-at-host 0) ?+)
178 (setq riece-user-at-host-type 'ok))))
179 (substring user-at-host 1))
180 (setq riece-user-at-host-type 'ok)
183 (defun riece-strip-user-at-host (user-at-host)
184 (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
185 (substring user-at-host 1)
188 (defun riece-get-users-on-server (server-name)
189 (delq nil (mapcar (lambda (identity)
190 (if (riece-user-p (riece-identity-prefix identity))
192 (riece-get-identities-on-server server-name))))
194 (defun riece-get-identities-on-server (server-name)
195 (riece-with-server-buffer server-name
200 (cons (riece-make-identity (symbol-name atom) server-name)
205 (defun riece-check-channel-commands-are-usable (&optional channel)
206 (unless riece-current-channel
207 (error (substitute-command-keys
208 "Type \\[riece-command-join] to join a channel")))
210 (not (riece-channel-p (riece-identity-prefix
211 riece-current-channel))))
212 (error "Not on a channel")))
214 (provide 'riece-misc)
216 ;;; riece-misc.el ends here