X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Friece-identity.el;h=b1a2f340d299db7ab9d16e5f2015c4518c52cc5d;hb=8e3039b5f63c6f417e37302acf8f3346090be7b4;hp=89e0e21e1dce5ec15f316914c3aab4ce2276570d;hpb=a6e0f1fa2e9cddd05d119dd4657b20f587998254;p=elisp%2Friece.git

diff --git a/lisp/riece-identity.el b/lisp/riece-identity.el
index 89e0e21..b1a2f34 100644
--- a/lisp/riece-identity.el
+++ b/lisp/riece-identity.el
@@ -19,14 +19,20 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
 (require 'riece-globals)
 (require 'riece-coding)
 
+(defcustom riece-channel-coding-system-alist nil
+  "An alist mapping from channels to coding-systems."
+  :type '(repeat (cons (string :tag "Channel")
+		       (symbol :tag "Coding system")))
+  :group 'riece-coding)
+
 (defvar riece-abbrev-identity-string-function nil)
 (defvar riece-expand-identity-string-function nil)
 
@@ -43,11 +49,11 @@ RFC2812, 2.2 \"Character codes\" says:
    equivalence of two nicknames or channel names.")
 
 (defun riece-identity-prefix (identity)
-  "Return the component sans its server from IDENTITY."
+  "Return the component sans its server name from IDENTITY."
   (aref identity 0))
 
 (defun riece-identity-server (identity)
-  "Return the server component in IDENTITY."
+  "Return the server name component in IDENTITY."
   (aref identity 1))
 
 (defun riece-make-identity (prefix server)
@@ -55,7 +61,7 @@ RFC2812, 2.2 \"Character codes\" says:
   (vector prefix server))
 
 (defun riece-identity-equal (ident1 ident2)
-  "Return t, if IDENT1 and IDENT2 is equal."
+  "Return t, if IDENT1 and IDENT2 are equal."
   (and (riece-identity-equal-no-server
 	(riece-identity-prefix ident1)
 	(riece-identity-prefix ident2))
@@ -67,7 +73,7 @@ RFC2812, 2.2 \"Character codes\" says:
   "Canonicalize identity PREFIX."
   (let ((i 0)
 	c)
-    (setq prefix (copy-sequence prefix))
+    (setq prefix (downcase prefix))
     (while (< i (length prefix))
       (if (setq c (cdr (assq (aref prefix i)
 			     riece-identity-prefix-case-pair-alist)))
@@ -76,7 +82,7 @@ RFC2812, 2.2 \"Character codes\" says:
     prefix))
 
 (defun riece-identity-equal-no-server (prefix1 prefix2)
-  "Return t, if IDENT1 and IDENT2 is equal without server part."
+  "Return t, if IDENT1 and IDENT2 are equal without server part."
   (equal (riece-identity-canonicalize-prefix prefix1)
 	 (riece-identity-canonicalize-prefix prefix2)))
 
@@ -138,7 +144,13 @@ will be added."
 		   (riece-identity-server identity)))))
     (if riece-abbrev-identity-string-function
 	(setq string (funcall riece-abbrev-identity-string-function string)))
-    (put-text-property 0 (length string) 'riece-identity identity string)
+    (riece-put-text-property-nonsticky 0 (length string)
+				       'riece-identity identity
+				       string)
+    (if prefix-only
+	(riece-put-text-property-nonsticky 0 (length string)
+					   'riece-format-identity-prefix-only t
+					   string))
     string))
 
 (defun riece-parse-identity (string)
@@ -156,7 +168,8 @@ The string will be expanded by
 
 (defun riece-completing-read-identity (prompt channels
 					      &optional predicate require-match
-					      initial history default)
+					      initial history default
+					      no-server)
   "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.
@@ -165,18 +178,52 @@ The rest of arguments are the same as `completing-read'."
 	  (completing-read
 	   prompt
 	   (mapcar (lambda (channel)
-		     (list (riece-format-identity channel)))
+		     (list (riece-format-identity channel no-server)))
 		   (delq nil (copy-sequence (or channels
 						riece-current-channels))))
 	   predicate require-match initial history default))
 	 (identity
 	  (riece-parse-identity string)))
-    (unless (string-match (concat "^\\(" riece-channel-regexp "\\|"
-				  riece-user-regexp "\\)")
-			  (riece-identity-prefix identity))
-      (error "Invalid channel name!"))
+;;;    (unless (string-match (concat "^\\(" riece-channel-regexp "\\|"
+;;;				  riece-user-regexp "\\)")
+;;;			  (riece-identity-prefix identity))
+;;;      (error "Invalid channel name!"))
     identity))
 
+(defun riece-coding-system-for-identity (identity)
+  (let ((alist riece-channel-coding-system-alist)
+	matcher)
+    (catch 'found
+      (while alist
+	(setq matcher (riece-parse-identity (car (car alist))))
+	(if (and (equal (riece-identity-server matcher)
+			(riece-identity-server identity))
+		 (equal (riece-identity-prefix matcher)
+			(riece-identity-prefix identity)))
+	    (throw 'found (cdr (car alist))))
+	(setq alist (cdr alist))))))
+
+(defun riece-decoded-string-for-identity (decoded identity)
+  "Return the string decoded for IDENTITY."
+  (let ((coding-system (riece-coding-system-for-identity identity)))
+    (if (and coding-system
+	     (not (eq (riece-decoded-coding-system decoded)
+		      (if (consp coding-system)
+			  (car coding-system)
+			coding-system))))
+	(riece-decode-coding-string-1 (riece-decoded-encoded-string decoded)
+				      coding-system)
+      decoded)))
+
+(defun riece-encode-coding-string-for-identity (string identity)
+  (let ((coding-system (riece-coding-system-for-identity identity)))
+    (if coding-system
+	(encode-coding-string string
+			      (if (consp coding-system)
+				  (cdr coding-system)
+				coding-system))
+      (riece-encode-coding-string string))))
+
 (provide 'riece-identity)
 
 ;;; riece-identity.el ends here