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-freeze (buffer &optional arg)
  76   (with-current-buffer buffer
  77     (setq riece-freeze (if arg (< 0 arg) (not riece-freeze))
  78           riece-freeze-indicator (if riece-freeze "F" "-"))
  79     (force-mode-line-update)))
  80
  81 (defun riece-frozen (buffer)
  82   (with-current-buffer buffer riece-freeze))
  83
  84 (defun riece-own-freeze (buffer &optional arg)
  85   (with-current-buffer buffer
  86     (setq riece-own-freeze (if arg (< 0 arg) (not riece-own-freeze))
  87           riece-own-freeze-indicator (if riece-own-freeze "M" "-"))
  88     (force-mode-line-update)))
  89
  90 (defun riece-process-send-string (process string)
  91   (with-current-buffer (process-buffer process)
  92     (process-send-string process (riece-encode-coding-string string))))
  93
  94 (defun riece-send-string (string)
  95   (let ((process (riece-find-server-process)))
  96     (unless process
  97       (error "%s" (substitute-command-keys
  98                    "Type \\[riece-command-open-server] to open server.")))
  99     (riece-process-send-string process string)))
 100
 101 (defun riece-split-parameters (string)
 102   (if (eq ?: (aref string 0))
 103       (list (substring string 1))
 104     (let (parameters)
 105       (catch 'done
 106         (while (string-match "^\\([^ ]+\\) +" string)
 107           (setq parameters (nconc parameters (list (match-string 1 string)))
 108                 string (substring string (match-end 0)))
 109           (and (not (equal "" string)) (eq ?: (aref string 0))
 110                (setq string (substring string 1))
 111                (throw 'done nil))))
 112       (or (equal "" string)
 113           (setq parameters (nconc parameters (list string))))
 114       parameters)))
 115
 116 (defun riece-concat-modes (target string)
 117   (let ((modes
 118          (if (riece-channel-p target)
 119              (riece-channel-get-modes target)
 120            (riece-user-get-modes target))))
 121     (if modes
 122         (concat string " [" (apply #'string modes) "]")
 123       string)))
 124
 125 (defsubst riece-concat-current-channel-modes (string)
 126   (if riece-current-channel
 127       (riece-concat-modes riece-current-channel string)
 128     string))
 129
 130 (defun riece-concat-message (string message)
 131   (if (or (null message)
 132           (equal message ""))
 133       string
 134     (concat string " (" message ")")))
 135
 136 (defun riece-concat-server-name (string)
 137   (riece-with-server-buffer
 138    (if riece-server-name
 139        (concat string " (from " riece-server-name ")")
 140      string)))
 141
 142 (defun riece-prefix-user-at-host (prefix)
 143   (if (string-match "!" prefix)
 144       (substring prefix (match-end 0))
 145     prefix))
 146
 147 (defun riece-prefix-nickname (prefix)
 148   (if (string-match "!" prefix)
 149       (substring prefix 0 (match-beginning 0))
 150     prefix))
 151
 152 (defun riece-parse-user-at-host (user-at-host)
 153   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 154       (progn
 155         (if (memq (aref user-at-host 0) '(?^ ?=))
 156             (setq riece-user-at-host-type 'fake)
 157           (if (memq (aref user-at-host 0) '(?~ ?-))
 158               (setq riece-user-at-host-type 'not-verified)
 159             (if (eq (aref user-at-host 0) ?+)
 160                 (setq riece-user-at-host-type 'ok))))
 161         (substring user-at-host 1))
 162     (setq riece-user-at-host-type 'ok)
 163     user-at-host))
 164
 165 (defun riece-strip-user-at-host (user-at-host)
 166   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 167       (substring user-at-host 1)
 168     user-at-host))
 169
 170 (defun riece-get-users-on-server ()
 171   (riece-with-server-buffer
 172    (let (users)
 173      (mapatoms
 174       (lambda (atom)
 175         (unless (riece-channel-p (symbol-name atom))
 176           (setq users (cons (symbol-name atom) users))))
 177       riece-obarray)
 178      (if (member riece-real-nickname users)
 179          users
 180        (cons riece-real-nickname users)))))
 181
 182 (provide 'riece-misc)
 183
 184 ;;; riece-misc.el ends here