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 (require 'riece-mode)
  35
  36 (defun riece-get-buffer-create (name &optional init-major-mode)
  37   (let ((buffer (get-buffer name)))
  38     (unless (and buffer
  39                  (or (null init-major-mode)
  40                      (eq (with-current-buffer buffer
  41                            major-mode)
  42                          init-major-mode)))
  43       (setq buffer (generate-new-buffer name)))
  44     (unless (memq buffer riece-buffer-list)
  45       (setq riece-buffer-list (cons buffer riece-buffer-list)))
  46     buffer))
  47
  48 (defun riece-scan-property-region (property start end function)
  49   (catch 'done
  50     (while t
  51       ;; Search for the beginning of the property region.
  52       (unless (get-text-property start property)
  53         (setq start (next-single-property-change start property nil end)))
  54       (if (= start end)
  55           (throw 'done nil))
  56       ;; Search for the end of the property region.
  57       (let ((region-end (next-single-property-change start property nil end)))
  58         (if (= region-end end)
  59             (throw 'done nil))
  60         (funcall function start region-end)
  61         (setq start region-end)))))
  62
  63 (defun riece-insert (buffers string)
  64   (unless (listp buffers)
  65     (setq buffers (list buffers)))
  66   (while buffers
  67     (run-hooks 'riece-before-insert-functions)
  68     (save-excursion
  69       (set-buffer (car buffers))
  70       (let ((inhibit-read-only t)
  71             buffer-read-only
  72             (start (goto-char (point-max)))
  73             (buffer (current-buffer))
  74             window
  75             point)
  76         (insert (format-time-string "%H:%M") " " string)
  77         (setq point (point))
  78         (if (and (not (riece-frozen (current-buffer)))
  79                  (setq window (get-buffer-window (current-buffer))))
  80             (save-excursion
  81               (save-selected-window
  82                 (select-window window)
  83                 (goto-char point)
  84                 (recenter -2))))
  85         (run-hook-with-args 'riece-after-insert-functions start (point))))
  86     (setq buffers (cdr buffers))))
  87
  88 (defun riece-insert-change (buffer message)
  89   (riece-insert buffer (concat riece-change-prefix message)))
  90
  91 (defun riece-insert-notice (buffer message)
  92   (riece-insert buffer (concat riece-notice-prefix message)))
  93
  94 (defun riece-insert-wallops (buffer message)
  95   (riece-insert buffer (concat riece-wallops-prefix message)))
  96
  97 (defun riece-insert-error (buffer message)
  98   (riece-insert buffer (concat riece-error-prefix message)))
  99
 100 (defun riece-insert-info (buffer message)
 101   (riece-insert buffer (concat riece-info-prefix message)))
 102
 103 (defun riece-frozen (buffer)
 104   (with-current-buffer buffer
 105     riece-freeze))
 106
 107 (defun riece-own-frozen (buffer)
 108   (with-current-buffer buffer
 109     (eq riece-freeze 'own)))
 110
 111 (defun riece-channel-p (string)
 112   "Return t if STRING is a channel.
 113 \(i.e. it matches `riece-channel-regexp')"
 114   (string-match (concat "^" riece-channel-regexp) string))
 115
 116 (defun riece-user-p (string)
 117   "Return t if STRING is a user.
 118 \(i.e. it matches `riece-user-regexp')"
 119   (string-match (concat "^" riece-user-regexp) string))
 120
 121 (defun riece-current-nickname ()
 122   "Return the current nickname."
 123   (riece-with-server-buffer (riece-current-server-name)
 124     (if riece-real-nickname
 125         (riece-make-identity riece-real-nickname riece-server-name))))
 126
 127 (defun riece-split-parameters (string)
 128   (if (eq ?: (aref string 0))
 129       (list (substring string 1))
 130     (let (parameters)
 131       (catch 'done
 132         (while (string-match "^\\([^ ]+\\) +" string)
 133           (setq parameters (nconc parameters (list (match-string 1 string)))
 134                 string (substring string (match-end 0)))
 135           (when (and (not (equal "" string)) (eq ?: (aref string 0)))
 136             (setq string (substring string 1)
 137                   parameters (nconc parameters (list string)))
 138             (throw 'done nil)))
 139         (or (equal "" string)
 140             (setq parameters (nconc parameters (list string)))))
 141       parameters)))
 142
 143 (defun riece-concat-channel-topic (target string)
 144   (riece-with-server-buffer (riece-identity-server target)
 145     (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
 146       (if (or (null topic)
 147               (equal topic ""))
 148           string
 149         (concat string ": " topic)))))
 150
 151 (defun riece-concat-channel-modes (target string)
 152   (riece-with-server-buffer (riece-identity-server target)
 153     (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
 154       (if modes
 155           (concat string " ["
 156                   (mapconcat
 157                    (lambda (mode)
 158                      (if (riece-mode-parameter mode)
 159                          (format "%c(%s)"
 160                                  (riece-mode-flag mode)
 161                                  (riece-mode-parameter mode))
 162                        (char-to-string (riece-mode-flag mode))))
 163                    modes "")
 164                   "]")
 165         string))))
 166
 167 (defun riece-concat-message (string message)
 168   (if (or (null message)
 169           (equal message ""))
 170       string
 171     (concat string " (" message ")")))
 172
 173 (defun riece-concat-server-name (string)
 174   (if (equal riece-server-name "")
 175       string
 176     (let ((server-name (concat " (from " riece-server-name ")")))
 177       (put-text-property 0 (length server-name)
 178                          'riece-server-name riece-server-name
 179                          server-name)
 180       (concat string server-name))))
 181
 182 (defun riece-concat-user-status (status string)
 183   (if status
 184       (concat string " [" (mapconcat #'identity status ", ") "]")
 185     string))
 186
 187 (defun riece-prefix-user-at-host (prefix)
 188   (if (string-match "!" prefix)
 189       (substring prefix (match-end 0))
 190     prefix))
 191
 192 (defun riece-prefix-nickname (prefix)
 193   (if (string-match "!" prefix)
 194       (substring prefix 0 (match-beginning 0))
 195     prefix))
 196
 197 (defun riece-parse-user-at-host (user-at-host)
 198   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 199       (progn
 200         (if (memq (aref user-at-host 0) '(?^ ?=))
 201             (setq riece-user-at-host-type 'fake)
 202           (if (memq (aref user-at-host 0) '(?~ ?-))
 203               (setq riece-user-at-host-type 'not-verified)
 204             (if (eq (aref user-at-host 0) ?+)
 205                 (setq riece-user-at-host-type 'ok))))
 206         (substring user-at-host 1))
 207     (setq riece-user-at-host-type 'ok)
 208     user-at-host))
 209
 210 (defun riece-strip-user-at-host (user-at-host)
 211   (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
 212       (substring user-at-host 1)
 213     user-at-host))
 214
 215 (defun riece-get-users-on-server (server-name)
 216   (delq nil (mapcar (lambda (identity)
 217                       (if (riece-user-p (riece-identity-prefix identity))
 218                           identity))
 219                     (riece-get-identities-on-server server-name))))
 220
 221 (defun riece-get-identities-on-server (server-name)
 222   (riece-with-server-buffer server-name
 223     (let (identities)
 224       (mapatoms
 225        (lambda (atom)
 226          (setq identities
 227                (cons (riece-make-identity (symbol-name atom) server-name)
 228                      identities)))
 229        riece-obarray)
 230       identities)))
 231
 232 (defun riece-check-channel-commands-are-usable (&optional channel)
 233    (unless riece-current-channel
 234      (error (substitute-command-keys
 235              "Type \\[riece-command-join] to join a channel")))
 236    (if (and channel
 237             (not (riece-channel-p (riece-identity-prefix
 238                                    riece-current-channel))))
 239        (error "Not on a channel")))
 240
 241 (provide 'riece-misc)
 242
 243 ;;; riece-misc.el ends here