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