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