X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-identity.el;h=e254dc35386b3b6c54c941b21c06a4878315a9f0;hp=0f12d547705f194a164c9d7174c5103a01740bb5;hb=acb16fddc18c48ef52cb680a911d8fae18da3ef3;hpb=8494a52113e0e498a2c0e6ff888ddaca095d669b

diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el
index 0f12d54..e254dc3 100644
--- a/lisp/riece-identity.el
+++ b/lisp/riece-identity.el
@@ -26,19 +26,22 @@
 
 (require 'riece-globals)
 (require 'riece-coding)
-(require 'riece-compat)			;riece-set-case-syntax-pair
 
 (defvar riece-abbrev-identity-string-function nil)
 (defvar riece-expand-identity-string-function nil)
 
-(defvar riece-identity-prefix-case-table
-  (let ((table (copy-case-table (standard-case-table))))
-    (riece-set-case-syntax-pair ?\[ ?{ table)
-    (riece-set-case-syntax-pair ?\] ?} table)
-    (riece-set-case-syntax-pair ?\\ ?| table)
-    (riece-set-case-syntax-pair ?~ ?^ table)
-    table))
-    
+(defconst riece-identity-prefix-case-pair-alist
+  '((?\[ . ?{)
+    (?\] . ?})
+    (?\\ . ?|)
+    (?~ . ?^))
+  "An alist used to canonicalize identity-prefix.
+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.")
+
 (defun riece-identity-prefix (identity)
   "Return the component sans its server from IDENTITY."
   (aref identity 0))
@@ -61,42 +64,41 @@
 	(riece-identity-server ident2))))
 
 (defun riece-identity-canonicalize-prefix (prefix)
-  "Canonicalize identity PREFIX.
-This function downcases PREFIX with Scandinavian alphabet rule.
-
-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 ((old-table (current-case-table)))
-    (unwind-protect
-	(progn
-	  (set-case-table riece-identity-prefix-case-table)
-	  (downcase prefix))
-      (set-case-table old-table))))
+  "Canonicalize identity PREFIX."
+  (let ((i 0)
+	c)
+    (setq prefix (downcase prefix))
+    (while (< i (length prefix))
+      (if (setq c (cdr (assq (aref prefix i)
+			     riece-identity-prefix-case-pair-alist)))
+	  (aset prefix i c))
+      (setq i (1+ i)))
+    prefix))
 
 (defun riece-identity-equal-no-server (prefix1 prefix2)
-  "Return t, if IDENT1 and IDENT2 is equal without server."
+  "Return t, if IDENT1 and IDENT2 is equal without server part."
   (equal (riece-identity-canonicalize-prefix prefix1)
 	 (riece-identity-canonicalize-prefix prefix2)))
 
-(defun riece-identity-member (elt list)
+(defun riece-identity-member (elt list &optional no-server)
   "Return non-nil if an identity ELT is an element of LIST."
   (catch 'found
     (while list
-      (if (and (vectorp (car list))	;needed because
-					;riece-current-channels
-					;contains nil.
-	       (riece-identity-equal (car list) elt))
+      (if (and (car list)	;needed because riece-current-channels
+				;contains nil.
+	       (if no-server
+		   (riece-identity-equal-no-server (car list) elt)
+		 (riece-identity-equal (car list) elt)))
 	  (throw 'found list)
 	(setq list (cdr list))))))
 
-(defun riece-identity-assoc (elt alist)
+(defun riece-identity-assoc (elt alist &optional no-server)
   "Return non-nil if an identity ELT matches the car of an element of ALIST."
   (catch 'found
     (while alist
-      (if (riece-identity-equal (car (car alist)) elt)
+      (if (if no-server
+	      (riece-identity-equal-no-server (car (car alist)) elt)
+	    (riece-identity-equal (car (car alist)) elt))
 	  (throw 'found (car alist))
 	(setq alist (cdr alist))))))
 
@@ -121,10 +123,17 @@ RFC2812, 2.2 \"Character codes\" says:
     list))
 
 (defun riece-format-identity (identity &optional prefix-only)
+  "Convert IDENTITY object to a string.
+If the optional 2nd argument PREFIX-ONLY is non-nil, don't append
+server part of the identity.
+
+The returned string will be abbreviated by
+`riece-abbrev-identity-string-function', and `riece-identity' property
+will be added."
   (let ((string
 	 (if (or prefix-only
 		 (equal (riece-identity-server identity) ""))
-	     (riece-identity-prefix identity)
+	     (copy-sequence (riece-identity-prefix identity))
 	   (concat (riece-identity-prefix identity) " "
 		   (riece-identity-server identity)))))
     (if riece-abbrev-identity-string-function
@@ -133,6 +142,9 @@ RFC2812, 2.2 \"Character codes\" says:
     string))
 
 (defun riece-parse-identity (string)
+  "Convert STRING to an identity object.
+The string will be expanded by
+`riece-expand-identity-string-function'."
   (if riece-expand-identity-string-function
       (setq string (funcall riece-expand-identity-string-function string)))
   (riece-make-identity (if (string-match " " string)
@@ -143,8 +155,12 @@ RFC2812, 2.2 \"Character codes\" says:
 			 "")))
 
 (defun riece-completing-read-identity (prompt channels
-					      &optional predicate must-match
-					      initial)
+					      &optional predicate require-match
+					      initial history default)
+  "Read an identity object in the minibuffer, with completion.
+PROMPT is a string to prompt with; normally it ends in a colon and a space.
+CHANNELS is a list of identity objects.
+The rest of arguments are the same as `completing-read'."
   (let* ((string
 	  (completing-read
 	   prompt
@@ -152,7 +168,7 @@ RFC2812, 2.2 \"Character codes\" says:
 		     (list (riece-format-identity channel)))
 		   (delq nil (copy-sequence (or channels
 						riece-current-channels))))
-	   predicate must-match initial))
+	   predicate require-match initial history default))
 	 (identity
 	  (riece-parse-identity string)))
     (unless (string-match (concat "^\\(" riece-channel-regexp "\\|"