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., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, 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 (defconst riece-alias-description
  65   "Define aliases for IRC names.")
  66
  67 (defun riece-alias-abbrev-percent-hack (string)
  68   (if (string-match (concat "^#\\([^ ]+\\):"
  69                             (regexp-quote riece-alias-percent-hack-mask)
  70                             "\\( .+\\|$\\)")
  71                     string)
  72       (replace-match "%\\1\\2" nil nil string)
  73     string))
  74
  75 (defun riece-alias-expand-percent-hack (string)
  76   (if (string-match "^%\\([^ ]+\\)\\( .+\\|$\\)" string)
  77       (replace-match (concat "#\\1:" riece-alias-percent-hack-mask "\\2")
  78                      nil nil string)
  79     string))
  80
  81 (defun riece-alias-escape-alternate-separator (string)
  82   (let ((index 0))
  83     (while (string-match (regexp-quote riece-alias-alternate-separator)
  84                          string index)
  85       (setq index (1+ (match-end 0))
  86             string (replace-match (concat riece-alias-alternate-separator
  87                                           riece-alias-alternate-separator)
  88                                   nil t string)))
  89     string))
  90
  91 (defun riece-alias-abbrev-alternate-separator (string)
  92   (if (string-match " " string)
  93       (let ((prefix (substring string 0 (match-beginning 0)))
  94             (server (substring string (match-end 0))))
  95         (concat (riece-alias-escape-alternate-separator prefix)
  96                 riece-alias-alternate-separator
  97                 (riece-alias-escape-alternate-separator server)))
  98     (riece-alias-escape-alternate-separator string)))
  99
 100 (defun riece-alias-expand-alternate-separator (string)
 101   (let ((index 0)
 102         prefix
 103         server)
 104     (while (and (null prefix)
 105                 (string-match
 106                  (concat (regexp-quote riece-alias-alternate-separator)
 107                          (regexp-quote riece-alias-alternate-separator)
 108                          "\\|\\("
 109                          (regexp-quote riece-alias-alternate-separator)
 110                          "\\)")
 111                  string index))
 112       (if (match-beginning 1)           ;found a separator
 113           (setq prefix (substring string 0 (match-beginning 1))
 114                 index (match-end 1))
 115         (setq string (replace-match riece-alias-alternate-separator
 116                                     nil t string)
 117               index (- (match-end 0)
 118                        (length riece-alias-alternate-separator)))))
 119     (if (null prefix)
 120         string
 121       (setq server (substring string index)
 122             index 0)
 123       (if (equal server "")
 124           (while (string-match (regexp-quote
 125                                 (concat riece-alias-alternate-separator
 126                                         riece-alias-alternate-separator))
 127                                server index)
 128             (setq server (replace-match riece-alias-alternate-separator
 129                                         nil t server)
 130                   index (- (match-end 0)
 131                            (length riece-alias-alternate-separator))))
 132         (concat prefix " " server)))))
 133
 134 (defun riece-alias-abbrev-identity-string (string)
 135   (if riece-alias-enable-percent-hack
 136       (setq string (riece-alias-abbrev-percent-hack string)))
 137   (if riece-alias-alternate-separator
 138       (setq string (riece-alias-abbrev-alternate-separator string)))
 139   (let ((alist riece-alias-alist))
 140     (while alist
 141       (if (equal (downcase (car (car alist))) (downcase string))
 142           (setq string (cdr (car alist))
 143                 alist nil)
 144         (setq alist (cdr alist)))))
 145   (copy-sequence string))
 146
 147 (defun riece-alias-expand-identity-string (string)
 148   (let ((alist riece-alias-alist))
 149     (while alist
 150       (if (equal (downcase (cdr (car alist))) (downcase string))
 151           (setq string (car (car alist))
 152                 alist nil)
 153         (setq alist (cdr alist)))))
 154   (if riece-alias-alternate-separator
 155       (setq string (riece-alias-expand-alternate-separator string)))
 156   (if riece-alias-enable-percent-hack
 157       (setq string (riece-alias-expand-percent-hack string)))
 158   (copy-sequence string))
 159
 160 (defun riece-alias-insinuate ()
 161   )
 162
 163 (defun riece-alias-enable ()
 164   (setq riece-abbrev-identity-string-function
 165         #'riece-alias-abbrev-identity-string
 166         riece-expand-identity-string-function
 167         #'riece-alias-expand-identity-string)
 168   (riece-emit-signal 'channel-list-changed))
 169
 170 (defun riece-alias-disable ()
 171   (setq riece-abbrev-identity-string-function nil
 172         riece-expand-identity-string-function nil)
 173   (riece-emit-signal 'channel-list-changed))
 174
 175 (provide 'riece-alias)
 176
 177 ;;; riece-alias.el ends here