cgit.sxemacs.org Git - riece/blob - lisp/riece-alias.el

   1 ;;; riece-alias.el --- define aliases for IRC names
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: IRC, riece
   6
   7 ;; This file is part of Riece.
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; NOTE: This is an add-on module for Riece.
  27
  28 ;; This add-on allows you to define aliases for IRC names.
  29
  30 ;; For example, if you want to define an alias `#r' for `#riece', you
  31 ;; can customize riece-alias-alist as follows:
  32 ;; (setq riece-alias-alist '(("#riece" . "#r")))
  33
  34 ;;; Code:
  35
  36 (require 'riece-identity)
  37 (require 'riece-signal)
  38
  39 (defgroup riece-alias nil
  40   "Aliases of channel/user names."
  41   :prefix "riece-"
  42   :group 'riece)
  43
  44 (defcustom riece-alias-percent-hack-mask "*.jp"
  45   "The mask of local IRC network"
  46   :type 'string
  47   :group 'riece-alias)
  48
  49 (defcustom riece-alias-enable-percent-hack t
  50   "If non-nil, the target mask is abbreviated with `%'."
  51   :type 'boolean
  52   :group 'riece-alias)
  53
  54 (defcustom riece-alias-alternate-separator "@"
  55   "A string to separate prefix and server."
  56   :type '(choice (const nil) string)
  57   :group 'riece-alias)
  58
  59 (defcustom riece-alias-alist nil
  60   "An alist mapping aliases to names."
  61   :type 'list
  62   :group 'riece-alias)
  63
  64 (defvar riece-alias-enabled nil)
  65
  66 (defconst riece-alias-description
  67   "Define aliases for IRC names.")
  68
  69 (defun riece-alias-abbrev-percent-hack (string)
  70   (if (string-match (concat "^#\\([^ ]+\\):"
  71                             (regexp-quote riece-alias-percent-hack-mask)
  72                             "\\( .+\\|$\\)")
  73                     string)
  74       (replace-match "%\\1\\2" nil nil string)
  75     string))
  76
  77 (defun riece-alias-expand-percent-hack (string)
  78   (if (string-match "^%\\([^ ]+\\)\\( .+\\|$\\)" string)
  79       (replace-match (concat "#\\1:" riece-alias-percent-hack-mask "\\2")
  80                      nil nil string)
  81     string))
  82
  83 (defun riece-alias-escape-alternate-separator (string)
  84   (let ((index 0))
  85     (while (string-match (regexp-quote riece-alias-alternate-separator)
  86                          string index)
  87       (setq index (1+ (match-end 0))
  88             string (replace-match (concat riece-alias-alternate-separator
  89                                           riece-alias-alternate-separator)
  90                                   nil t string)))
  91     string))
  92
  93 (defun riece-alias-abbrev-alternate-separator (string)
  94   (if (string-match " " string)
  95       (let ((prefix (substring string 0 (match-beginning 0)))
  96             (server (substring string (match-end 0))))
  97         (concat (riece-alias-escape-alternate-separator prefix)
  98                 riece-alias-alternate-separator
  99                 (riece-alias-escape-alternate-separator server)))
 100     (riece-alias-escape-alternate-separator string)))
 101
 102 (defun riece-alias-expand-alternate-separator (string)
 103   (let ((index 0)
 104         prefix
 105         server)
 106     (while (and (null prefix)
 107                 (string-match
 108                  (concat (regexp-quote riece-alias-alternate-separator)
 109                          (regexp-quote riece-alias-alternate-separator)
 110                          "\\|\\("
 111                          (regexp-quote riece-alias-alternate-separator)
 112                          "\\)")
 113                  string index))
 114       (if (match-beginning 1)           ;found a separator
 115           (setq prefix (substring string 0 (match-beginning 1))
 116                 index (match-end 1))
 117         (setq string (replace-match riece-alias-alternate-separator
 118                                     nil t string)
 119               index (- (match-end 0)
 120                        (length riece-alias-alternate-separator)))))
 121     (if (null prefix)
 122         string
 123       (setq server (substring string index)
 124             index 0)
 125       (if (equal server "")
 126           (while (string-match (regexp-quote
 127                                 (concat riece-alias-alternate-separator
 128                                         riece-alias-alternate-separator))
 129                                server index)
 130             (setq server (replace-match riece-alias-alternate-separator
 131                                         nil t server)
 132                   index (- (match-end 0)
 133                            (length riece-alias-alternate-separator))))
 134         (concat prefix " " server)))))
 135
 136 (defun riece-alias-abbrev-identity-string (string)
 137   (if riece-alias-enable-percent-hack
 138       (setq string (riece-alias-abbrev-percent-hack string)))
 139   (if riece-alias-alternate-separator
 140       (setq string (riece-alias-abbrev-alternate-separator string)))
 141   (let ((alist riece-alias-alist))
 142     (while alist
 143       (if (equal (car (car alist)) string)
 144           (setq string (cdr (car alist))
 145                 alist nil)
 146         (setq alist (cdr alist)))))
 147   (copy-sequence string))
 148
 149 (defun riece-alias-expand-identity-string (string)
 150   (let ((alist riece-alias-alist))
 151     (while alist
 152       (if (equal (cdr (car alist)) string)
 153           (setq string (car (car alist))
 154                 alist nil)
 155         (setq alist (cdr alist)))))
 156   (if riece-alias-alternate-separator
 157       (setq string (riece-alias-expand-alternate-separator string)))
 158   (if riece-alias-enable-percent-hack
 159       (setq string (riece-alias-expand-percent-hack string)))
 160   (copy-sequence string))
 161
 162 (defun riece-alias-insinuate ()
 163   )
 164
 165 (defun riece-alias-enable ()
 166   (setq riece-abbrev-identity-string-function
 167         #'riece-alias-abbrev-identity-string
 168         riece-expand-identity-string-function
 169         #'riece-alias-expand-identity-string)
 170   (riece-emit-signal 'channel-list-changed)
 171   (setq riece-alias-enabled t))
 172
 173 (defun riece-alias-disable ()
 174   (setq riece-abbrev-identity-string-function nil
 175         riece-expand-identity-string-function nil)
 176   (riece-emit-signal 'channel-list-changed)
 177   (setq riece-alias-enabled nil))
 178
 179 (provide 'riece-alias)
 180
 181 ;;; riece-alias.el ends here