cgit.sxemacs.org Git - riece/blob - 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
  35 (defun riece-get-buffer-create (name &optional init-major-mode)
  36   (let ((buffer (get-buffer name)))
  37     (unless (and buffer
  38                  (or (null init-major-mode)
  39                      (eq (with-current-buffer buffer
  40                            major-mode)
  41                          init-major-mode)))
  42       (setq buffer (generate-new-buffer name)))
  43     (unless (memq buffer riece-buffer-list)
  44       (setq riece-buffer-list (cons buffer riece-buffer-list)))
  45     buffer))
  46
  47 (defun riece-scan-property-region (property start end function)
  48   (catch 'done
  49     (while t
  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)))
  53       (if (= start end)
  54           (throw 'done nil))
  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)
  58             (throw 'done nil))
  59         (funcall function start region-end)
  60         (setq start region-end)))))
  61
  62 (defun riece-insert (buffers string)
  63   (unless (listp buffers)
  64     (setq buffers (list buffers)))
  65   (while buffers
  66     (run-hooks 'riece-before-insert-functions)
  67     (save-excursion
  68       (set-buffer (car buffers))
  69       (let ((inhibit-read-only t)
  70             buffer-read-only
  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))
  76                               (point)))
  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           (and (not (equal "" string)) (eq ?: (aref string 0))
 128                (setq string (substring string 1))
 129                (throw 'done nil))))
 130       (or (equal "" string)
 131           (setq parameters (nconc parameters (list string))))
 132       parameters)))
 133
 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))))
 137       (if (or (null topic)
 138               (equal topic ""))
 139           string
 140         (concat string ": " topic)))))
 141
 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))))
 145       (if modes
 146           (concat string " [" (apply #'string modes) "]")
 147         string))))
 148
 149 (defun riece-concat-message (string message)
 150   (if (or (null message)
 151           (equal message ""))
 152       string
 153     (concat string " (" message ")")))
 154
 155 (defun riece-concat-server-name (string)
 156   (if (equal riece-server-name "")
 157       string
 158     (concat string " (from " riece-server-name ")")))
 159
 160 (defun riece-concat-user-status (status string)
 161   (if status
 162       (concat string " [" (mapconcat #'identity status ", ") "]")
 163     string))
 164
 165 (defun riece-prefix-user-at-host (prefix)
 166   (if (string-match "!" prefix)
 167       (substring prefix (match-end 0))
 168     prefix))
 169
 170 (defun riece-prefix-nickname (prefix)
 171   (if (string-match "!" prefix)
 172       (substring prefix 0 (match-beginning 0))
 173     prefix))
 174
 175 (defun riece-parse-user-at-host (user-at-host)
 176   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 177       (progn
 178         (if (memq (aref user-at-host 0) '(?^ ?=))
 179             (setq riece-user-at-host-type 'fake)
 180           (if (memq (aref user-at-host 0) '(?~ ?-))
 181               (setq riece-user-at-host-type 'not-verified)
 182             (if (eq (aref user-at-host 0) ?+)
 183                 (setq riece-user-at-host-type 'ok))))
 184         (substring user-at-host 1))
 185     (setq riece-user-at-host-type 'ok)
 186     user-at-host))
 187
 188 (defun riece-strip-user-at-host (user-at-host)
 189   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 190       (substring user-at-host 1)
 191     user-at-host))
 192
 193 (defun riece-get-users-on-server (server-name)
 194   (delq nil (mapcar (lambda (identity)
 195                       (if (riece-user-p (riece-identity-prefix identity))
 196                           identity))
 197                     (riece-get-identities-on-server server-name))))
 198
 199 (defun riece-get-identities-on-server (server-name)
 200   (riece-with-server-buffer server-name
 201     (let (identities)
 202       (mapatoms
 203        (lambda (atom)
 204          (setq identities
 205                (cons (riece-make-identity (symbol-name atom) server-name)
 206                      identities)))
 207        riece-obarray)
 208       identities)))
 209
 210 (defun riece-check-channel-commands-are-usable (&optional channel)
 211    (unless riece-current-channel
 212      (error (substitute-command-keys
 213              "Type \\[riece-command-join] to join a channel")))
 214    (if (and channel
 215             (not (riece-channel-p (riece-identity-prefix
 216                                    riece-current-channel))))
 217        (error "Not on a channel")))
 218
 219 (provide 'riece-misc)
 220
 221 ;;; riece-misc.el ends here