X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-alias.el;h=1fd0314eb410437c9e27ab7bc8fcba64366bbfd5;hb=d5d1e5dba1629394c1a4fb0629804419f84f56a1;hp=a617687938e7cff802ebd440b81498e07d30e2c5;hpb=ff91df38a07ec9b3994b38854151d5d3f8b8eb2f;p=riece diff --git a/lisp/riece-alias.el b/lisp/riece-alias.el index a617687..1fd0314 100644 --- a/lisp/riece-alias.el +++ b/lisp/riece-alias.el @@ -1,4 +1,4 @@ -;;; riece-alias.el --- define aliases of names +;;; riece-alias.el --- define aliases for IRC names ;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno @@ -21,14 +21,15 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;; This add-on allows you to define aliases for IRC names. +;;; Commentary: + +;; NOTE: This is an add-on module for Riece. -;; To use, add the following line to your ~/.riece/init.el: -;; (add-to-list 'riece-addons 'riece-alias) +;; This add-on allows you to define aliases for IRC names. -;; For example, if you want to define an alias `#l' for `#Liece', you +;; For example, if you want to define an alias `#r' for `#riece', you ;; can customize riece-alias-alist as follows: -;; (setq riece-alias-alist '(("#Liece" . "#l"))) +;; (setq riece-alias-alist '(("#riece" . "#r"))) ;;; Code: @@ -36,7 +37,7 @@ (require 'riece-signal) (defgroup riece-alias nil - "Define aliases of names" + "Aliases of channel/user names." :prefix "riece-" :group 'riece) @@ -50,9 +51,9 @@ :type 'boolean :group 'riece-alias) -(defcustom riece-alias-use-atmark nil - "If non-nil, use atmark to separate prefix and server." - :type 'boolean +(defcustom riece-alias-alternate-separator "@" + "A string to separate prefix and server." + :type '(choice (const nil) string) :group 'riece-alias) (defcustom riece-alias-alist nil @@ -60,10 +61,8 @@ :type 'list :group 'riece-alias) -(defvar riece-alias-enabled nil) - (defconst riece-alias-description - "Define aliases of channel/user names") + "Define aliases for IRC names.") (defun riece-alias-abbrev-percent-hack (string) (if (string-match (concat "^#\\([^ ]+\\):" @@ -79,68 +78,84 @@ nil nil string) string)) -(defun riece-alias-escape-atmark (string) +(defun riece-alias-escape-alternate-separator (string) (let ((index 0)) - (while (string-match "@" string index) + (while (string-match (regexp-quote riece-alias-alternate-separator) + string index) (setq index (1+ (match-end 0)) - string (replace-match "@@" nil nil string))) + string (replace-match (concat riece-alias-alternate-separator + riece-alias-alternate-separator) + nil t string))) string)) -(defun riece-alias-abbrev-atmark (string) +(defun riece-alias-abbrev-alternate-separator (string) (if (string-match " " string) (let ((prefix (substring string 0 (match-beginning 0))) (server (substring string (match-end 0)))) - (concat (riece-alias-escape-atmark prefix) "@" - (riece-alias-escape-atmark server))) - (concat (riece-alias-escape-atmark string) "@"))) + (concat (riece-alias-escape-alternate-separator prefix) + riece-alias-alternate-separator + (riece-alias-escape-alternate-separator server))) + (riece-alias-escape-alternate-separator string))) -(defun riece-alias-expand-atmark (string) +(defun riece-alias-expand-alternate-separator (string) (let ((index 0) prefix - server - length) + server) (while (and (null prefix) - (string-match "@+" string index)) - (setq length (- (match-end 0) (match-beginning 0)) - string (replace-match (make-string (/ length 2) ?@) - nil nil string) - index (+ (match-beginning 0) (/ length 2))) - (unless (zerop (% length 2)) - (setq prefix (substring string 0 index)))) - (setq server (substring string index) - index 0) - (if (equal server "") - prefix - (while (string-match "@@" server index) - (setq server (replace-match "@" nil nil server) - index (1- (match-end 0)))) - (concat prefix " " server)))) + (string-match + (concat (regexp-quote riece-alias-alternate-separator) + (regexp-quote riece-alias-alternate-separator) + "\\|\\(" + (regexp-quote riece-alias-alternate-separator) + "\\)") + string index)) + (if (match-beginning 1) ;found a separator + (setq prefix (substring string 0 (match-beginning 1)) + index (match-end 1)) + (setq string (replace-match riece-alias-alternate-separator + nil t string) + index (- (match-end 0) + (length riece-alias-alternate-separator))))) + (if (null prefix) + string + (setq server (substring string index) + index 0) + (if (equal server "") + (while (string-match (regexp-quote + (concat riece-alias-alternate-separator + riece-alias-alternate-separator)) + server index) + (setq server (replace-match riece-alias-alternate-separator + nil t server) + index (- (match-end 0) + (length riece-alias-alternate-separator)))) + (concat prefix " " server))))) (defun riece-alias-abbrev-identity-string (string) (if riece-alias-enable-percent-hack (setq string (riece-alias-abbrev-percent-hack string))) - (if riece-alias-use-atmark - (setq string (riece-alias-abbrev-atmark string))) + (if riece-alias-alternate-separator + (setq string (riece-alias-abbrev-alternate-separator string))) (let ((alist riece-alias-alist)) - (catch 'done - (while alist - (if (equal (car (car alist)) string) - (throw 'done (cdr (car alist)))) - (setq alist (cdr alist))) - string))) + (while alist + (if (equal (downcase (car (car alist))) (downcase string)) + (setq string (cdr (car alist)) + alist nil) + (setq alist (cdr alist))))) + (copy-sequence string)) (defun riece-alias-expand-identity-string (string) + (let ((alist riece-alias-alist)) + (while alist + (if (equal (downcase (cdr (car alist))) (downcase string)) + (setq string (car (car alist)) + alist nil) + (setq alist (cdr alist))))) + (if riece-alias-alternate-separator + (setq string (riece-alias-expand-alternate-separator string))) (if riece-alias-enable-percent-hack (setq string (riece-alias-expand-percent-hack string))) - (if riece-alias-use-atmark - (setq string (riece-alias-expand-atmark string))) - (let ((alist riece-alias-alist)) - (catch 'done - (while alist - (if (equal (cdr (car alist)) string) - (throw 'done (car (car alist)))) - (setq alist (cdr alist))) - string))) + (copy-sequence string)) (defun riece-alias-insinuate () ) @@ -150,14 +165,12 @@ #'riece-alias-abbrev-identity-string riece-expand-identity-string-function #'riece-alias-expand-identity-string) - (riece-emit-signal 'channel-list-changed) - (setq riece-alias-enabled t)) + (riece-emit-signal 'channel-list-changed)) (defun riece-alias-disable () (setq riece-abbrev-identity-string-function nil riece-expand-identity-string-function nil) - (riece-emit-signal 'channel-list-changed) - (setq riece-alias-enabled nil)) + (riece-emit-signal 'channel-list-changed)) (provide 'riece-alias)