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)
  36   (let ((buffer (get-buffer-create name)))
  37     (unless (memq buffer riece-buffer-list)
  38       (setq riece-buffer-list (cons buffer riece-buffer-list)))
  39     buffer))
  40
  41 (defun riece-insert (buffers string)
  42   (unless (listp buffers)
  43     (setq buffers (list buffers)))
  44   (while buffers
  45     (run-hooks 'riece-before-insert-functions)
  46     (save-excursion
  47       (set-buffer (riece-get-buffer-create (car buffers)))
  48       (let ((inhibit-read-only t)
  49             buffer-read-only
  50             (start (goto-char (point-max))))
  51         (insert (format-time-string "%H:%M") " " string)
  52         (if (and (not (riece-frozen (current-buffer)))
  53                  (get-buffer-window (current-buffer)))
  54             (set-window-point (get-buffer-window (current-buffer))
  55                               (point)))
  56         (run-hook-with-args 'riece-after-insert-functions start (point))))
  57     (setq buffers (cdr buffers))))
  58
  59 (defun riece-insert-change (buffer message)
  60   (riece-insert buffer (concat riece-change-prefix message)))
  61
  62 (defun riece-insert-notice (buffer message)
  63   (riece-insert buffer (concat riece-notice-prefix message)))
  64
  65 (defun riece-insert-wallops (buffer message)
  66   (riece-insert buffer (concat riece-wallops-prefix message)))
  67
  68 (defun riece-insert-error (buffer message)
  69   (riece-insert buffer (concat riece-error-prefix message)))
  70
  71 (defun riece-insert-info (buffer message)
  72   (riece-insert buffer (concat riece-info-prefix message)))
  73
  74 (defun riece-frozen (buffer)
  75   (with-current-buffer buffer
  76     riece-freeze))
  77
  78 (defun riece-own-frozen (buffer)
  79   (with-current-buffer buffer
  80     (eq riece-freeze 'own)))
  81
  82 (defun riece-channel-p (string)
  83   "Return t if STRING is a channel.
  84 \(i.e. it matches `riece-channel-regexp')"
  85   (string-match (concat "^" riece-channel-regexp) string))
  86
  87 (defun riece-current-nickname ()
  88   "Return the current nickname."
  89   (riece-with-server-buffer (riece-identity-server riece-current-channel)
  90     (if riece-real-nickname
  91         (riece-make-identity riece-real-nickname riece-server-name))))
  92
  93 (defun riece-split-parameters (string)
  94   (if (eq ?: (aref string 0))
  95       (list (substring string 1))
  96     (let (parameters)
  97       (catch 'done
  98         (while (string-match "^\\([^ ]+\\) +" string)
  99           (setq parameters (nconc parameters (list (match-string 1 string)))
 100                 string (substring string (match-end 0)))
 101           (and (not (equal "" string)) (eq ?: (aref string 0))
 102                (setq string (substring string 1))
 103                (throw 'done nil))))
 104       (or (equal "" string)
 105           (setq parameters (nconc parameters (list string))))
 106       parameters)))
 107
 108 (defun riece-concat-channel-topic (target string)
 109   (riece-with-server-buffer (riece-identity-server target)
 110     (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
 111       (if (or (null topic)
 112               (equal topic ""))
 113           string
 114         (concat string ": " topic)))))
 115
 116 (defun riece-concat-channel-modes (target string)
 117   (riece-with-server-buffer (riece-identity-server target)
 118     (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
 119       (if modes
 120           (concat string " [" (apply #'string modes) "]")
 121         string))))
 122
 123 (defun riece-concat-message (string message)
 124   (if (or (null message)
 125           (equal message ""))
 126       string
 127     (concat string " (" message ")")))
 128
 129 (defun riece-concat-server-name (string)
 130   (if (equal riece-server-name "")
 131       string
 132     (concat string " (from " riece-server-name ")")))
 133
 134 (defun riece-prefix-user-at-host (prefix)
 135   (if (string-match "!" prefix)
 136       (substring prefix (match-end 0))
 137     prefix))
 138
 139 (defun riece-prefix-nickname (prefix)
 140   (if (string-match "!" prefix)
 141       (substring prefix 0 (match-beginning 0))
 142     prefix))
 143
 144 (defun riece-parse-user-at-host (user-at-host)
 145   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 146       (progn
 147         (if (memq (aref user-at-host 0) '(?^ ?=))
 148             (setq riece-user-at-host-type 'fake)
 149           (if (memq (aref user-at-host 0) '(?~ ?-))
 150               (setq riece-user-at-host-type 'not-verified)
 151             (if (eq (aref user-at-host 0) ?+)
 152                 (setq riece-user-at-host-type 'ok))))
 153         (substring user-at-host 1))
 154     (setq riece-user-at-host-type 'ok)
 155     user-at-host))
 156
 157 (defun riece-strip-user-at-host (user-at-host)
 158   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 159       (substring user-at-host 1)
 160     user-at-host))
 161
 162 (defun riece-get-users-on-server ()
 163   (riece-with-server-buffer (riece-identity-server riece-current-channel)
 164     (let (users)
 165       (mapatoms
 166        (lambda (atom)
 167          (unless (riece-channel-p (symbol-name atom))
 168            (setq users (cons (symbol-name atom) users))))
 169        riece-obarray)
 170       (if (member riece-real-nickname users)
 171           users
 172         (cons riece-real-nickname users)))))
 173
 174 (provide 'riece-misc)
 175
 176 ;;; riece-misc.el ends here