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