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 (eval-when-compile (require 'riece-inlines))
29 (require 'riece-options)
30 (require 'riece-coding)
31 (require 'riece-identity)
32 (require 'riece-version)
33 (require 'riece-channel)
36 (defun riece-get-buffer-create (name)
37 (let ((buffer (get-buffer-create name)))
38 (unless (memq buffer riece-buffer-list)
39 (setq riece-buffer-list (cons buffer riece-buffer-list)))
42 (defun riece-insert (buffers string)
43 (unless (listp buffers)
44 (setq buffers (list buffers)))
46 (run-hooks 'riece-before-insert-functions)
48 (set-buffer (riece-get-buffer-create (car buffers)))
49 (let ((inhibit-read-only t)
51 (start (goto-char (point-max))))
52 (insert (format-time-string "%H:%M") " " string)
53 (if (and (not (riece-frozen (current-buffer)))
54 (get-buffer-window (current-buffer)))
55 (set-window-point (get-buffer-window (current-buffer))
57 (run-hook-with-args 'riece-after-insert-functions start (point))))
58 (setq buffers (cdr buffers))))
60 (defun riece-insert-change (buffer message)
61 (riece-insert buffer (concat riece-change-prefix message)))
63 (defun riece-insert-notice (buffer message)
64 (riece-insert buffer (concat riece-notice-prefix message)))
66 (defun riece-insert-wallops (buffer message)
67 (riece-insert buffer (concat riece-wallops-prefix message)))
69 (defun riece-insert-error (buffer message)
70 (riece-insert buffer (concat riece-error-prefix message)))
72 (defun riece-insert-info (buffer message)
73 (riece-insert buffer (concat riece-info-prefix message)))
75 (defun riece-freeze (buffer &optional arg)
76 (with-current-buffer buffer
77 (setq riece-freeze (if arg (< 0 arg) (not riece-freeze))
78 riece-freeze-indicator (if riece-freeze "F" "-"))
79 (force-mode-line-update)))
81 (defun riece-frozen (buffer)
82 (with-current-buffer buffer riece-freeze))
84 (defun riece-own-freeze (buffer &optional arg)
85 (with-current-buffer buffer
86 (setq riece-own-freeze (if arg (< 0 arg) (not riece-own-freeze))
87 riece-own-freeze-indicator (if riece-own-freeze "M" "-"))
88 (force-mode-line-update)))
90 (defun riece-process-send-string (process string)
91 (with-current-buffer (process-buffer process)
92 (process-send-string process (riece-encode-coding-string string))))
94 (defun riece-send-string (string)
95 (let ((process (riece-find-server-process)))
97 (error "%s" (substitute-command-keys
98 "Type \\[riece-command-open-server] to open server.")))
99 (riece-process-send-string process string)))
101 (defun riece-split-parameters (string)
102 (if (eq ?: (aref string 0))
103 (list (substring string 1))
106 (while (string-match "^\\([^ ]+\\) +" string)
107 (setq parameters (nconc parameters (list (match-string 1 string)))
108 string (substring string (match-end 0)))
109 (and (not (equal "" string)) (eq ?: (aref string 0))
110 (setq string (substring string 1))
112 (or (equal "" string)
113 (setq parameters (nconc parameters (list string))))
116 (defun riece-concat-modes (target string)
118 (if (riece-channel-p target)
119 (riece-channel-get-modes target)
120 (riece-user-get-modes target))))
122 (concat string " [" (apply #'string modes) "]")
125 (defsubst riece-concat-current-channel-modes (string)
126 (if riece-current-channel
127 (riece-concat-modes riece-current-channel string)
130 (defun riece-concat-message (string message)
131 (if (or (null message)
134 (concat string " (" message ")")))
136 (defun riece-concat-server-name (string)
137 (riece-with-server-buffer
138 (if riece-server-name
139 (concat string " (from " riece-server-name ")")
142 (defun riece-prefix-user-at-host (prefix)
143 (if (string-match "!" prefix)
144 (substring prefix (match-end 0))
147 (defun riece-prefix-nickname (prefix)
148 (if (string-match "!" prefix)
149 (substring prefix 0 (match-beginning 0))
152 (defun riece-parse-user-at-host (user-at-host)
153 (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
155 (if (memq (aref user-at-host 0) '(?^ ?=))
156 (setq riece-user-at-host-type 'fake)
157 (if (memq (aref user-at-host 0) '(?~ ?-))
158 (setq riece-user-at-host-type 'not-verified)
159 (if (eq (aref user-at-host 0) ?+)
160 (setq riece-user-at-host-type 'ok))))
161 (substring user-at-host 1))
162 (setq riece-user-at-host-type 'ok)
165 (defun riece-strip-user-at-host (user-at-host)
166 (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
167 (substring user-at-host 1)
170 (defun riece-get-users-on-server ()
171 (riece-with-server-buffer
175 (unless (riece-channel-p (symbol-name atom))
176 (setq users (cons (symbol-name atom) users))))
178 (if (member riece-real-nickname users)
180 (cons riece-real-nickname users)))))
182 (provide 'riece-misc)
184 ;;; riece-misc.el ends here