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