1 ;;; riece-misc.el --- miscellaneous functions (not inlined) -*- lexical-binding: t -*-
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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, 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 (require 'riece-cache)
37 (defun riece-get-buffer-create (name &optional init-major-mode)
38 (let ((buffer (get-buffer name)))
40 (or (null init-major-mode)
41 (eq (with-current-buffer buffer
44 (setq buffer (generate-new-buffer name)))
45 (unless (memq buffer riece-buffer-list)
46 (setq riece-buffer-list (cons buffer riece-buffer-list)))
49 (defun riece-scan-property-region (property start end function)
52 ;; Search for the beginning of the property region.
53 (unless (get-text-property start property)
54 (setq start (next-single-property-change start property nil end)))
57 ;; Search for the end of the property region.
58 (let ((region-end (next-single-property-change start property nil end)))
59 (if (= region-end end)
61 (funcall function start region-end)
62 (setq start region-end)))))
64 (defun riece-insert (buffers string)
65 (unless (listp buffers)
66 (setq buffers (list buffers)))
68 (run-hooks 'riece-before-insert-functions)
69 (with-current-buffer (car buffers)
70 (let ((inhibit-read-only t)
75 ;; Save the current for the case when (car buffers) is the
76 ;; currently selected buffer.
78 (setq start (goto-char (point-max)))
79 (insert (format-time-string "%H:%M") " " string)
81 (if (and (not (riece-frozen (current-buffer)))
82 (setq window (get-buffer-window (current-buffer)))
83 (not (pos-visible-in-window-p point window)))
84 (save-excursion ;save-selected-window changes
87 (select-window window)
88 (goto-char point) ;select-window changes current point
89 (recenter riece-window-center-line))))
90 (run-hook-with-args 'riece-after-insert-functions start point)))
91 (setq buffers (cdr buffers))))
93 (defun riece-insert-change (buffer message)
94 (riece-insert buffer (concat riece-change-prefix message)))
96 (defun riece-insert-notice (buffer message)
97 (riece-insert buffer (concat riece-notice-prefix message)))
99 (defun riece-insert-wallops (buffer message)
100 (riece-insert buffer (concat riece-wallops-prefix message)))
102 (defun riece-insert-error (buffer message)
103 (riece-insert buffer (concat riece-error-prefix message)))
105 (defun riece-insert-info (buffer message)
106 (riece-insert buffer (concat riece-info-prefix message)))
108 (defun riece-frozen (buffer)
109 (with-current-buffer buffer
112 (defun riece-own-frozen (buffer)
113 (with-current-buffer buffer
114 (eq riece-freeze 'own)))
116 (defun riece-channel-p (string)
117 "Return t if STRING is a channel.
118 \(i.e. it matches `riece-channel-regexp')"
119 (string-match (concat "^" riece-channel-regexp) string))
121 (defun riece-user-p (string)
122 "Return t if STRING is a user.
123 \(i.e. it matches `riece-user-regexp')"
124 (string-match (concat "^" riece-user-regexp) string))
126 (defun riece-current-nickname ()
127 "Return the current nickname."
128 (riece-with-server-buffer (riece-current-server-name)
129 (if riece-real-nickname
130 (riece-make-identity riece-real-nickname riece-server-name))))
132 (defun riece-split-parameters (string)
133 (if (eq ?: (aref string 0))
134 (list (substring string 1))
137 (while (string-match "^\\([^ ]+\\) +" string)
138 (setq parameters (nconc parameters (list (match-string 1 string)))
139 string (substring string (match-end 0)))
140 (when (and (not (equal "" string)) (eq ?: (aref string 0)))
141 (setq string (substring string 1)
142 parameters (nconc parameters (list string)))
144 (or (equal "" string)
145 (setq parameters (nconc parameters (list string)))))
148 (defun riece-concat-channel-topic (target string)
149 (riece-with-server-buffer (riece-identity-server target)
150 (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
154 (concat string ": " topic)))))
156 (defun riece-concat-channel-modes (target string)
157 (riece-with-server-buffer (riece-identity-server target)
158 (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
163 (if (riece-mode-parameter mode)
165 (riece-mode-flag mode)
166 (riece-mode-parameter mode))
167 (char-to-string (riece-mode-flag mode))))
172 (defun riece-concat-message (string message)
173 (if (or (null message)
176 (concat string " (" message ")")))
178 (defun riece-concat-server-name (string)
179 (if (equal riece-server-name "")
181 (let ((server-name (concat " (from " riece-server-name ")")))
182 (put-text-property 0 (length server-name)
183 'riece-server-name riece-server-name
185 (concat string server-name))))
187 (defun riece-concat-user-status (status string)
189 (concat string " [" (mapconcat #'identity status ", ") "]")
192 (defun riece-prefix-user-at-host (prefix)
193 (if (string-match "!" prefix)
194 (substring prefix (match-end 0))
197 (defun riece-prefix-nickname (prefix)
198 (if (string-match "!" prefix)
199 (substring prefix 0 (match-beginning 0))
202 (defun riece-parse-user-at-host (user-at-host)
203 (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
205 (if (memq (aref user-at-host 0) '(?^ ?=))
206 (setq riece-user-at-host-type 'fake)
207 (if (memq (aref user-at-host 0) '(?~ ?-))
208 (setq riece-user-at-host-type 'not-verified)
209 (if (eq (aref user-at-host 0) ?+)
210 (setq riece-user-at-host-type 'ok))))
211 (substring user-at-host 1))
212 (setq riece-user-at-host-type 'ok)
215 (defun riece-strip-user-at-host (user-at-host)
216 (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
217 (substring user-at-host 1)
220 (defun riece-get-users-on-server (server-name)
221 (riece-with-server-buffer server-name
226 (cons (riece-make-identity (symbol-name user) server-name)
228 (riece-cache-hash-obarray riece-user-cache))
231 (defun riece-get-channels-on-server (server-name)
232 (riece-with-server-buffer server-name
237 (cons (riece-make-identity (symbol-name channel) server-name)
239 (riece-cache-hash-obarray riece-channel-cache))
242 (defun riece-get-identities-on-server (server-name)
243 (nconc (riece-get-channels-on-server server-name)
244 (riece-get-users-on-server server-name)))
246 (defun riece-check-channel-commands-are-usable (&optional channel)
247 (unless riece-current-channel
248 (error (substitute-command-keys
249 "Type \\[riece-command-join] to join a channel")))
251 (not (riece-channel-p (riece-identity-prefix
252 riece-current-channel))))
253 (error "Not on a channel")))
255 (provide 'riece-misc)
257 ;;; riece-misc.el ends here