[Erc-help] [PATCH] erc-track.el: XEmacs compatibilty issue

[Sebastian F. <fr...@ma...>]

This patch intends to provides FACE colored channel strings for the
modeline within XEmacs (where extents have to be used).
Additionally the channel string separator is customizable now and the name
of the face (rather the first letter of the face) is optionally visible.

ChangeLog addition:

2004-06-18  Sebastian Freundt <hro...@gn...>

	* erc-track.el: colored modified channel strings in XEmacs




Index: erc-track.el
===================================================================
RCS file: /cvsroot/erc/erc/erc-track.el,v
retrieving revision 1.64
diff -u -r1.64 erc-track.el
--- erc-track.el	13 May 2004 18:08:05 -0000	1.64
+++ erc-track.el	18 Jun 2004 01:05:37 -0000
@@ -154,6 +154,16 @@
 		 (repeat string)
 		 (const all)))
 
+(defcustom erc-track-modified-channel-string-separator ","
+	"Separator string inserted between elements of the modified channels string."
+	:group 'erc-track
+	:type 'string)
+
+(defcustom erc-track-display-face-name-p nil
+  "Whether to display the face name's first letter with each channel."
+  :group 'erc-track
+  :type 'boolean)
+
 (defvar erc-modified-channels-string ""
   "Internal string used for displaying modified channels in the mode line.")
 
@@ -478,11 +488,21 @@
   ;; defvar a keymap, 2. the user is not interested in customizing it
   ;; (really?), 3. the defun needs to switch to BUFFER, so we would
   ;; need to save that value somewhere.
-  (let ((map (make-sparse-keymap))
+  (let* ((map (make-sparse-keymap))
+    (face-string (and erc-track-display-face-name-p
+      (let* ((face-string (split-string (format "%S" faces) "-"))
+             (face-string (remove "erc" face-string))
+             (face-string (remove "face" face-string))
+             (face-string (mapconcat (lambda (item)
+                            (substring item 0 1))
+                            face-string "")))
+        face-string)))
 	(name (if erc-track-showcount
 		  (concat string
 			  erc-track-showcount-string
-			  (int-to-string count))
+			  (int-to-string count)
+				(and erc-track-display-face-name-p
+          face-string))
 		(copy-sequence string))))
     (define-key map (vector 'mode-line 'mouse-2)
       `(lambda (e)
@@ -499,8 +519,13 @@
 	    (posn-window (event-start e)))
 	   (switch-to-buffer-other-window ,buffer))))
     (put-text-property 0 (length name) 'local-map map name)
-    (when (and faces erc-track-use-faces)
-      (put-text-property 0 (length name) 'face faces name))
+    (if (featurep 'xemacs)
+        (when (and faces erc-track-use-faces)
+			(let ((tmpxt (make-extent nil nil)))
+				(set-extent-face tmpxt faces)
+				(setq name (list (cons tmpxt name)))))
+      (when (and faces erc-track-use-faces)
+        (put-text-property 0 (length name) 'face faces name)))
     name))
 
 (defun erc-modified-channels-display ()
@@ -540,7 +565,28 @@
 	      counts (cdr counts)
 	      faces (cdr faces)))
       (setq erc-modified-channels-string
-	    (concat " [" (mapconcat 'identity (nreverse strings) ",") "] ")))))
+      (if (featurep 'xemacs)
+          (list "[" (erc-track-make-modified-channels-string strings) "] ")
+        (concat " [" (mapconcat 'identity (nreverse strings)
+                       erc-track-modified-channel-string-separator) "] "))))))
+
+(defun erc-track-make-modified-channels-string (strings)
+  "Creates a string for `erc-modified-channels-string'.
+This is an XEmacs compatibility function as it is not possible
+to mapconcat extents."
+	(let ((chan-strings (nreverse strings))
+				result)
+		(while (car chan-strings)
+      (setq result
+            (let ((ch-string-car (car chan-strings))
+                  (nch-string (car (cdr-safe chan-strings))))
+              (if nch-string
+                  (append result 
+                    `(,ch-string-car 
+                      ,erc-track-modified-channel-string-separator))
+                (append result (list ch-string-car))))
+            chan-strings (cdr chan-strings)))
+    result))
 
 (defun erc-modified-channels-remove-buffer (buffer)
   "Remove BUFFER from `erc-modified-channels-alist'."