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 (eval-when-compile (require 'riece-inlines))
  28
  29 (require 'riece-options)
  30 (require 'riece-coding)
  31 (require 'riece-identity)
  32 (require 'riece-version)
  33 (require 'riece-channel)
  34 (require 'riece-user)
  35
  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)))
  40     buffer))
  41
  42 (defun riece-insert (buffers string)
  43   (unless (listp buffers)
  44     (setq buffers (list buffers)))
  45   (while buffers
  46     (run-hooks 'riece-before-insert-functions)
  47     (save-excursion
  48       (set-buffer (riece-get-buffer-create (car buffers)))
  49       (let ((inhibit-read-only t)
  50             buffer-read-only
  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))
  56                               (point)))
  57         (run-hook-with-args 'riece-after-insert-functions start (point))))
  58     (setq buffers (cdr buffers))))
  59
  60 (defun riece-insert-change (buffer message)
  61   (riece-insert buffer (concat riece-change-prefix message)))
  62
  63 (defun riece-insert-notice (buffer message)
  64   (riece-insert buffer (concat riece-notice-prefix message)))
  65
  66 (defun riece-insert-wallops (buffer message)
  67   (riece-insert buffer (concat riece-wallops-prefix message)))
  68
  69 (defun riece-insert-error (buffer message)
  70   (riece-insert buffer (concat riece-error-prefix message)))
  71
  72 (defun riece-insert-info (buffer message)
  73   (riece-insert buffer (concat riece-info-prefix message)))
  74
  75 (defun riece-frozen (buffer)
  76   (with-current-buffer buffer
  77     riece-freeze))
  78
  79 (defun riece-own-frozen (buffer)
  80   (with-current-buffer buffer
  81     (eq riece-freeze 'own)))
  82
  83 (defun riece-process-send-string (process string)
  84   (with-current-buffer (process-buffer process)
  85     (process-send-string process (riece-encode-coding-string string))))
  86
  87 (defun riece-send-string (string)
  88   (let ((process (riece-find-server-process)))
  89     (unless process
  90       (error "%s" (substitute-command-keys
  91                    "Type \\[riece-command-open-server] to open server.")))
  92     (riece-process-send-string process string)))
  93
  94 (defun riece-split-parameters (string)
  95   (if (eq ?: (aref string 0))
  96       (list (substring string 1))
  97     (let (parameters)
  98       (catch 'done
  99         (while (string-match "^\\([^ ]+\\) +" string)
 100           (setq parameters (nconc parameters (list (match-string 1 string)))
 101                 string (substring string (match-end 0)))
 102           (and (not (equal "" string)) (eq ?: (aref string 0))
 103                (setq string (substring string 1))
 104                (throw 'done nil))))
 105       (or (equal "" string)
 106           (setq parameters (nconc parameters (list string))))
 107       parameters)))
 108
 109 (defun riece-concat-modes (target string)
 110   (let ((modes
 111          (if (riece-channel-p target)
 112              (riece-channel-get-modes target)
 113            (riece-user-get-modes target))))
 114     (if modes
 115         (concat string " [" (apply #'string modes) "]")
 116       string)))
 117
 118 (defsubst riece-concat-current-channel-modes (string)
 119   (if riece-current-channel
 120       (riece-concat-modes riece-current-channel string)
 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   (riece-with-server-buffer
 131    (if riece-server-name
 132        (concat string " (from " riece-server-name ")")
 133      string)))
 134
 135 (defun riece-prefix-user-at-host (prefix)
 136   (if (string-match "!" prefix)
 137       (substring prefix (match-end 0))
 138     prefix))
 139
 140 (defun riece-prefix-nickname (prefix)
 141   (if (string-match "!" prefix)
 142       (substring prefix 0 (match-beginning 0))
 143     prefix))
 144
 145 (defun riece-parse-user-at-host (user-at-host)
 146   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 147       (progn
 148         (if (memq (aref user-at-host 0) '(?^ ?=))
 149             (setq riece-user-at-host-type 'fake)
 150           (if (memq (aref user-at-host 0) '(?~ ?-))
 151               (setq riece-user-at-host-type 'not-verified)
 152             (if (eq (aref user-at-host 0) ?+)
 153                 (setq riece-user-at-host-type 'ok))))
 154         (substring user-at-host 1))
 155     (setq riece-user-at-host-type 'ok)
 156     user-at-host))
 157
 158 (defun riece-strip-user-at-host (user-at-host)
 159   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 160       (substring user-at-host 1)
 161     user-at-host))
 162
 163 (defun riece-get-users-on-server ()
 164   (riece-with-server-buffer
 165    (let (users)
 166      (mapatoms
 167       (lambda (atom)
 168         (unless (riece-channel-p (symbol-name atom))
 169           (setq users (cons (symbol-name atom) users))))
 170       riece-obarray)
 171      (if (member riece-real-nickname users)
 172          users
 173        (cons riece-real-nickname users)))))
 174
 175 (provide 'riece-misc)
 176
 177 ;;; riece-misc.el ends here