Don't use old-style backquote in doc/ptexinfmt.el.
[riece] / 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