From: ueno Date: Tue, 3 Jun 2003 09:39:07 +0000 (+0000) Subject: * riece-identity.el (riece-identity-canonicalize-prefix): Moved X-Git-Tag: strict-naming-branchpoint~5 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5fd1fc530e3aed912d077d115f54b55563497d8f;p=elisp%2Friece.git * riece-identity.el (riece-identity-canonicalize-prefix): Moved from riece-inlines.el; renamed from scandinavian-downcase. (riece-identity-equal-no-server): Moved from riece-inlines.el; renamed from scandinavian-equal-ignore-case. (riece-identity-equal-no-server-safe): New function. (riece-identity-member-no-server): Moved from riece-inlines.el; renamed from scandinavian-member-ignore-case. (riece-identity-member-no-server-safe): New function. * riece-inlines.el: Removed. * COMPILE (riece-modules): Remove riece-inlines. * Makefile.am (EXTRA_DIST): Remove riece-inlines.el. --- diff --git a/lisp/COMPILE b/lisp/COMPILE index 4cf3e31..fde0e89 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -8,7 +8,6 @@ '(riece-globals riece-options riece-version - riece-inlines riece-coding riece-complete diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fe9d0b2..50288a4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,20 @@ 2003-06-03 Daiki Ueno + * riece-identity.el (riece-identity-canonicalize-prefix): Moved + from riece-inlines.el; renamed from scandinavian-downcase. + (riece-identity-equal-no-server): Moved from riece-inlines.el; + renamed from scandinavian-equal-ignore-case. + (riece-identity-equal-no-server-safe): New function. + (riece-identity-member-no-server): Moved from riece-inlines.el; + renamed from scandinavian-member-ignore-case. + (riece-identity-member-no-server-safe): New function. + + * riece-inlines.el: Removed. + * COMPILE (riece-modules): Remove riece-inlines. + * Makefile.am (EXTRA_DIST): Remove riece-inlines.el. + +2003-06-03 Daiki Ueno + * riece-rdcc.el (riece-rdcc-sentinel): Don't call delete-process explicitly. * riece-ndcc.el: Don't call delete-process explicitly. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index 340c425..efa84d4 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -3,7 +3,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-channel.el riece-coding.el riece-commands.el riece-compat.el \ riece-complete.el riece-display.el riece-emacs.el riece-filter.el \ riece-globals.el riece-handle.el riece-highlight.el riece-identity.el \ - riece-inlines.el riece-message.el riece-misc.el riece-naming.el \ + riece-message.el riece-misc.el riece-naming.el \ riece-options.el riece-server.el riece-user.el riece-version.el \ riece-xemacs.el riece.el \ riece-ctcp.el riece-url.el riece-unread.el \ diff --git a/lisp/riece-channel.el b/lisp/riece-channel.el index 0d32bdf..7895d8b 100644 --- a/lisp/riece-channel.el +++ b/lisp/riece-channel.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'riece-inlines)) ;scandinavian-downcase - (require 'riece-options) (require 'riece-identity) @@ -47,7 +45,7 @@ (defun riece-find-channel (name) "Get a channel object named NAME from the server buffer." (riece-with-server-buffer - (let ((symbol (intern-soft (scandinavian-downcase + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix (riece-identity-prefix name)) riece-obarray))) (if symbol @@ -55,7 +53,7 @@ (defun riece-forget-channel (name) (riece-with-server-buffer - (let ((symbol (intern-soft (scandinavian-downcase + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix (riece-identity-prefix name))))) (when symbol (makunbound symbol) @@ -72,12 +70,12 @@ the channel key, respectively." (defun riece-get-channel (name) (riece-with-server-buffer - (let ((symbol (intern-soft (scandinavian-downcase + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix (riece-identity-prefix name)) riece-obarray))) (if symbol (symbol-value symbol) - (set (intern (scandinavian-downcase + (set (intern (riece-identity-canonicalize-prefix (riece-identity-prefix name)) riece-obarray) (riece-make-channel)))))) diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el index ed5dcbd..7f9f654 100644 --- a/lisp/riece-commands.el +++ b/lisp/riece-commands.el @@ -73,7 +73,7 @@ "Select the next channel." (interactive) (when (> (length riece-current-channels) 1) - (let ((pointer (cdr (scandinavian-member-ignore-case + (let ((pointer (cdr (riece-identity-member-no-server riece-current-channel riece-current-channels)))) (while (and pointer @@ -92,7 +92,7 @@ "Select the previous channel." (interactive) (when (> (length riece-current-channels) 1) - (let ((pointer (scandinavian-member-ignore-case + (let ((pointer (riece-identity-member-no-server riece-current-channel riece-current-channels)) (start riece-current-channels) diff --git a/lisp/riece-handle.el b/lisp/riece-handle.el index 05a2607..89ecbee 100644 --- a/lisp/riece-handle.el +++ b/lisp/riece-handle.el @@ -107,7 +107,7 @@ (while channels (riece-naming-assert-join user (car channels)) ;;XXX - (if (scandinavian-equal-ignore-case user riece-real-nickname) + (if (riece-identity-equal-no-server user riece-real-nickname) (riece-switch-to-channel (riece-make-identity (car channels)))) (let ((buffer (cdr (riece-identity-assoc (riece-make-identity (car channels)) @@ -200,7 +200,7 @@ (pointer channels) (message (car (riece-split-parameters string)))) ;; If you are quitting, no need to cleanup. - (unless (scandinavian-equal-ignore-case user riece-real-nickname) + (unless (riece-identity-equal-no-server user riece-real-nickname) ;; You were talking with the user. (if (riece-identity-member (riece-make-identity user) riece-current-channels) diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el index 0591c81..69f742d 100644 --- a/lisp/riece-identity.el +++ b/lisp/riece-identity.el @@ -91,6 +91,45 @@ server name before comparison." ident2 (riece-make-identity ident2)))) +(defun riece-identity-canonicalize-prefix (prefix) + "Canonicalize identity PREFIX. +This function downcases PREFIX first, then does special treatment for +Scandinavian alphabets. + +RFC2812, 2.2 \"Character codes\" says: + Because of IRC's Scandinavian origin, the characters {}|^ are + considered to be the lower case equivalents of the characters []\~, + respectively. This is a critical issue when determining the + equivalence of two nicknames or channel names." + (let* ((result (downcase prefix)) + (length (length result)) + (index 0)) + (while (< index length) + (if (eq (aref result index) ?\[) + (aset result index ?{) + (if (eq (aref result index) ?\]) + (aset result index ?}) + (if (eq (aref result index) ?\\) + (aset result index ?|) + (if (eq (aref result index) ?~) + (aset result index ?^))))) + (setq index (1+ index))) + result)) + +(defun riece-identity-equal-no-server (prefix1 prefix2) + "Return t, if IDENT1 and IDENT2 is equal without server." + (equal (riece-identity-canonicalize-prefix prefix1) + (riece-identity-canonicalize-prefix prefix2))) + +(defun riece-identity-equal-no-server-safe (prefix1 prefix2) + "Return t, if IDENT1 and IDENT2 is equal without server. +The only difference with `riece-identity-no-server', this function removes +server name before comparison." + (equal (riece-identity-canonicalize-prefix + (riece-identity-prefix prefix1)) + (riece-identity-canonicalize-prefix + (riece-identity-prefix prefix2)))) + (defun riece-identity-member (elt list) "Return non-nil if an identity ELT is an element of LIST." (catch 'found @@ -111,6 +150,28 @@ The only difference with `riece-identity-member', this function uses (throw 'found list) (setq list (cdr list)))))) +(defun riece-identity-member-no-server (elt list) + "Return non-nil if an identity ELT is an element of LIST. +The only difference with `riece-identity-member', this function doesn't +take server names into account." + (catch 'found + (while list + (if (and (stringp (car list)) + (riece-identity-equal-no-server (car list) elt)) + (throw 'found list) + (setq list (cdr list)))))) + +(defun riece-identity-member-no-server-safe (elt list) + "Return non-nil if an identity ELT is an element of LIST. +The only difference with `riece-identity-member-no-server', this function uses +`riece-identity-equal-no-server-safe' for comparison." + (catch 'found + (while list + (if (and (stringp (car list)) + (riece-identity-equal-no-server-safe (car list) elt)) + (throw 'found list) + (setq list (cdr list)))))) + (defun riece-identity-assoc (elt alist) "Return non-nil if an identity ELT matches the car of an element of ALIST." (catch 'found diff --git a/lisp/riece-inlines.el b/lisp/riece-inlines.el deleted file mode 100644 index 8c85d4a..0000000 --- a/lisp/riece-inlines.el +++ /dev/null @@ -1,64 +0,0 @@ -;;; riece-inlines.el --- inline functions -;; Copyright (C) 1998-2003 Daiki Ueno - -;; Author: Daiki Ueno -;; Created: 1998-09-28 -;; Keywords: IRC, riece - -;; This file is part of Riece. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; RFC2812, 2.2 "Character codes" says: -;; Because of IRC's Scandinavian origin, the characters {}|^ are -;; considered to be the lower case equivalents of the characters []\~, -;; respectively. This is a critical issue when determining the -;; equivalence of two nicknames or channel names. - -;;; Code: - -(defsubst scandinavian-downcase (string) - (let* ((result (downcase string)) - (length (length result)) - (index 0)) - (while (< index length) - (if (eq (aref result index) ?\[) - (aset result index ?{) - (if (eq (aref result index) ?\]) - (aset result index ?}) - (if (eq (aref result index) ?\\) - (aset result index ?|) - (if (eq (aref result index) ?~) - (aset result index ?^))))) - (setq index (1+ index))) - result)) - -(defsubst scandinavian-equal-ignore-case (s1 s2) - (string-equal (scandinavian-downcase s1) (scandinavian-downcase s2))) - -(defsubst scandinavian-member-ignore-case (thing list) - (catch 'found - (while list - (if (and (stringp (car list)) - (scandinavian-equal-ignore-case (car list) thing)) - (throw 'found list) - (setq list (cdr list)))))) - -(provide 'riece-inlines) - -;;; riece-inlines.el ends here diff --git a/lisp/riece-naming.el b/lisp/riece-naming.el index afd7f7e..7828605 100644 --- a/lisp/riece-naming.el +++ b/lisp/riece-naming.el @@ -32,13 +32,13 @@ (require 'riece-display) (defun riece-naming-assert-join (user-name channel-name) - (if (scandinavian-equal-ignore-case user-name riece-real-nickname) + (if (riece-identity-equal-no-server user-name riece-real-nickname) (riece-join-channel channel-name)) (riece-user-toggle-channel user-name channel-name t) (riece-channel-toggle-user channel-name user-name t)) (defun riece-naming-assert-part (user-name channel-name) - (if (scandinavian-equal-ignore-case user-name riece-real-nickname) + (if (riece-identity-equal-no-server user-name riece-real-nickname) (progn (riece-part-channel channel-name) (riece-forget-channel channel-name)) @@ -54,7 +54,7 @@ (setcar pointer nil)))))) (defun riece-naming-assert-rename (old-name new-name) - (if (scandinavian-equal-ignore-case old-name riece-real-nickname) + (if (riece-identity-equal-no-server old-name riece-real-nickname) (setq riece-last-nickname riece-real-nickname riece-real-nickname new-name)) (let* ((old (riece-get-user old-name)) diff --git a/lisp/riece-user.el b/lisp/riece-user.el index eff9521..323e276 100644 --- a/lisp/riece-user.el +++ b/lisp/riece-user.el @@ -23,8 +23,6 @@ ;;; Code: -(eval-when-compile (require 'riece-inlines)) ;scandinavian-downcase - (require 'riece-identity) (defconst riece-user-regexp @@ -34,7 +32,7 @@ (defun riece-find-user (name) "Get a user object named NAME from the server buffer." (riece-with-server-buffer - (let ((symbol (intern-soft (scandinavian-downcase + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix (riece-identity-prefix name)) riece-obarray))) (if symbol @@ -42,7 +40,7 @@ (defun riece-forget-user (name) (riece-with-server-buffer - (let ((symbol (intern-soft (scandinavian-downcase + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix (riece-identity-prefix name))))) (when symbol (makunbound symbol) @@ -50,15 +48,15 @@ (defun riece-rename-user (old-name new-name) (riece-with-server-buffer - (unless (equal (scandinavian-downcase + (unless (equal (riece-identity-canonicalize-prefix (riece-identity-prefix old-name)) - (scandinavian-downcase + (riece-identity-canonicalize-prefix (riece-identity-prefix new-name))) - (let ((symbol (intern-soft (scandinavian-downcase + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix (riece-identity-prefix old-name)) riece-obarray))) (when symbol - (set (intern (scandinavian-downcase + (set (intern (riece-identity-canonicalize-prefix (riece-identity-prefix new-name)) riece-obarray) (symbol-value symbol)) @@ -73,12 +71,12 @@ away status, respectively." (defun riece-get-user (name) (riece-with-server-buffer - (let ((symbol (intern-soft (scandinavian-downcase + (let ((symbol (intern-soft (riece-identity-canonicalize-prefix (riece-identity-prefix name)) riece-obarray))) (if symbol (symbol-value symbol) - (set (intern (scandinavian-downcase + (set (intern (riece-identity-canonicalize-prefix (riece-identity-prefix name)) riece-obarray) (riece-make-user))))))