rcirc changes

[Miles Bader <miles.bader@necel.com>]

Hi,

I didn't like the format rcirc used to show conversations, so I wrote a
bit of code to allow more customizability; what do you think of the
following patch?

Two basic changes:

(1) add `rcirc-nick-abbrevs' to allow nicknames for nicknames when
    printing :-) -- mainly so I could change how it printed _my_ name,
    which takes up too much space on the screen, but doesn't seem able
    to be changed using existing mechanisms (I can change other users'
    nicknames in bitlbee though).

(2) Rewrite `rcirc-format-response-string' to use a more flexible
    formatting system controlled by the variable `rcirc-response-formats'
    (and change the way `rcirc-print' finds the fill prefix so that it
    works when non-standard formats are used).
    
Thanks,

-Miles


M  lisp/net/rcirc.el
M  lisp/ChangeLog

* modified files

--- orig/lisp/ChangeLog
+++ mod/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2006-02-09  Miles Bader  <miles@gnu.org>
+
+	* net/rcirc.el (rcirc-nick-abbrevs, rcirc-response-formats):
+	New variables.
+	(rcirc-abbrev-nick): New function.
+	(rcirc-format-response-string): Rewrite to use the formats in
+	`rcirc-response-formats' and expand escape sequences therein.
+	A text-property `rcirc-text' is added over the actual response
+	text to make easy to find inside the returned string.
+	(rcirc-print): When filling, just look for the `rcirc-text'
+	text-property to find the appropriate fill prefix, instead of
+	using hardwired patterns.
+
 2006-02-07  Mathias Dahl  <brakjoller@hotmail.com>
 
 	* dired.el (dired-mode-map): Add more bindings for tumme.


--- orig/lisp/net/rcirc.el
+++ mod/lisp/net/rcirc.el
@@ -187,6 +187,11 @@
   :type '(repeat string)
   :group 'rcirc)
 
+(defcustom rcirc-nick-abbrevs nil
+  "List of short replacements for printing nicks."
+  :type '(alist :key-type string :value-type string)
+  :group 'rcirc)
+
 (defvar rcirc-ignore-list-automatic ()
   "List of ignored nicks added to `rcirc-ignore-list' because of renaming.
 When an ignored person renames, their nick is added to both lists.
@@ -470,6 +475,11 @@
   (with-rcirc-process-buffer process
     rcirc-nick))
 
+(defun rcirc-abbrev-nick (nick)
+  "If NICK has an entry in `rcirc-nick-abbrevs', return its abbreviation,
+otherwise return NICK."
+  (or (cdr (assoc nick rcirc-nick-abbrevs)) nick))
+
 (defvar rcirc-max-message-length 450
   "Messages longer than this value will be split.")
 
@@ -879,46 +889,111 @@
 	buffer
       (process-buffer process))))
 
+(defcustom rcirc-response-formats
+  '(("PRIVMSG" . "%T<%n> %m")
+    ("NOTICE"  . "%T-%n- %m")
+    ("ACTION"  . "%T[%n] %m")
+    ("COMMAND" . "%T%m")
+    ("ERROR"   . "%T%fw!!! %m")
+    (t         . "%T%fp*** %fs%n %r %m"))
+  "An alist of formats used for printing responses.
+The format is looked up using the response-type as a key;
+if no match is found, the default entry (with a key of `t') is used.
+
+The entry's value part should be a string, which is inserted with
+the of the following escape sequences replaced by the described values:
+
+  %m        The message text
+  %n        The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick')
+  %r        The response-type
+  %T        The timestamp (with face `rcirc-timestamp')
+  %t        The target
+  %fw       Following text uses the face `font-lock-warning-face'
+  %fp       Following text uses the face `rcirc-server-prefix'
+  %fs       Following text uses the face `rcirc-server'
+  %f[FACE]  Following text uses the face FACE
+  %f-        Following text uses the default face
+  %%        A literal `%' character
+"
+  :type '(alist :key-type (choice (string :tag "Type")
+				  (const :tag "Default" t))
+		:value-type string)
+  :group 'rcirc)
+
 (defun rcirc-format-response-string (process sender response target text)
-  (concat (rcirc-facify (format-time-string rcirc-time-format (current-time))
-			'rcirc-timestamp)
-          (cond ((or (string= response "PRIVMSG")
-                     (string= response "NOTICE")
-                     (string= response "ACTION"))
-                 (let (first middle end)
-                   (cond ((string= response "PRIVMSG")
-                          (setq first "<" middle "> "))
-                         ((string= response "NOTICE")
-			  (when sender
-			    (setq first "-" middle "- ")))
-                         (t
-                          (setq first "[" middle " " end "]")))
-                   (concat first
-                           (rcirc-facify (rcirc-user-nick sender)
-                                         (if (string= sender
-                                                      (rcirc-nick process))
-                                             'rcirc-my-nick
-                                           'rcirc-other-nick))
-                           middle
-                           (rcirc-mangle-text process text)
-                           end)))
-                ((string= response "COMMAND")
-                 text)
-                ((string= response "ERROR")
-                 (propertize (concat "!!! " text)
-			     'face 'font-lock-warning-face))
-                (t
-                 (rcirc-mangle-text
-                  process
-		  (concat (rcirc-facify "*** " 'rcirc-server-prefix)
-			  (rcirc-facify
-			   (concat
-			    (when (not (string= sender (rcirc-server process)))
-			      (concat (rcirc-user-nick sender) " "))
-			    (when (zerop (string-to-number response))
-			      (concat response " "))
-			    text)
-			   'rcirc-server)))))))
+  "Return a nicely-formatted response string, incorporating TEXT
+(and perhaps other arguments).  The specific formatting used
+is found by looking up RESPONSE in `rcirc-response-formats'."
+  (let ((chunks
+	 (split-string (or (cdr (assoc response rcirc-response-formats))
+			       (cdr (assq t rcirc-response-formats)))
+		       "%"))
+	(result "")
+	(face nil)
+	key face-key repl)
+    (when (equal (car chunks) "")
+      (pop chunks))
+    (dolist (chunk chunks)
+      (if (equal chunk "")
+	  (setq key ?%)
+	(setq key (aref chunk 0))
+	(setq chunk (substring chunk 1)))
+      (setq repl
+	    (cond ((eq key ?%)
+		   ;; %% -- literal % character
+		   "%")
+		  ((eq key ?n)
+		   ;; %n -- nick
+		   (rcirc-facify (rcirc-abbrev-nick (rcirc-user-nick sender))
+				 (if (string= sender (rcirc-nick process))
+				     'rcirc-my-nick
+				   'rcirc-other-nick)))
+		  ((eq key ?T)
+		   ;; %T -- timestamp
+		   (rcirc-facify
+		    (format-time-string rcirc-time-format (current-time))
+		    'rcirc-timestamp))
+		  ((eq key ?m)
+		   ;; %m -- message text
+		   ;; We add the text property `rcirc-text' to identify this
+		   ;; as the body text.
+		   (propertize
+		    (rcirc-mangle-text process (rcirc-facify text face))
+		    'rcirc-text text))
+		  ((eq key ?t)
+		   ;; %t -- target
+		   (rcirc-facify (or rcirc-target "") face))
+		  ((eq key ?r)
+		   ;; %r -- response
+		   (rcirc-facify response face))
+		  ((eq key ?f)
+		   ;; %f -- change face
+		   (setq face-key (aref chunk 0))
+		   (cond ((eq face-key ?w)
+			  ;; %fw -- warning face
+			  (setq face 'font-lock-warning-face))
+			 ((eq face-key ?p)
+			  ;; %fp -- server-prefix face
+			  (setq face 'rcirc-server-prefix))
+			 ((eq face-key ?s)
+			  ;; %fs -- warning face
+			  (setq face 'rcirc-server))
+			 ((eq face-key ?-)
+			  ;; %fs -- warning face
+			  (setq face nil))
+			 ((and (eq face-key ?\[)
+			       (string-match "^[[]\\([^]]*\\)[]]" chunk)
+			       (facep (match-string 1 chunk)))
+			  ;; %f[...] -- named face
+			  (setq face (intern (match-string 1 chunk)))
+			  (setq chunk (substring chunk (match-end 1)))))
+		   (setq chunk (substring chunk 1))
+		   "")
+		  (t
+		   ;; just insert the key literally
+		   (rcirc-facify (substring chunk 0 1) face))))
+      (setq result (concat result repl (rcirc-facify chunk face))))
+    result))
 
 (defvar rcirc-activity-type nil)
 (make-variable-buffer-local 'rcirc-activity-type)
@@ -960,38 +1035,31 @@
 	  (goto-char rcirc-prompt-start-marker)
 	  (set-marker-insertion-type rcirc-prompt-start-marker t)
 	  (set-marker-insertion-type rcirc-prompt-end-marker t)
-	  (insert
-	   (rcirc-format-response-string process sender response target text)
-	   (propertize "\n" 'hard t))
-	  (set-marker-insertion-type rcirc-prompt-start-marker nil)
-	  (set-marker-insertion-type rcirc-prompt-end-marker nil)
-
-	  ;; fill the text we just inserted, maybe
-	  (when (and rcirc-fill-flag
-		     (not (string= response "372"))) ;/motd
-	    (let ((fill-prefix
-		   (or rcirc-fill-prefix
-		       (make-string
-			(+ (if rcirc-time-format
-			       (length (format-time-string
-					rcirc-time-format))
-			     0)
-			   (cond ((or (string= response "PRIVMSG")
-				      (string= response "NOTICE"))
-				  (+ (length (rcirc-user-nick sender))
-				     2)) ; <>
-				 ((string= response "ACTION")
-				  (+ (length (rcirc-user-nick sender))
-				     1))	; [
-				 (t 3))		; ***
-			   1)
-			?\s)))
-		  (fill-column (cond ((eq rcirc-fill-column 'frame-width)
-				      (1- (frame-width)))
-				     (rcirc-fill-column
-				      rcirc-fill-column)
-				     (t fill-column))))
-	      (fill-region fill-start rcirc-prompt-start-marker 'left t)))
+
+	  (let ((fmted-text
+		 (rcirc-format-response-string process sender response target
+					       text)))
+
+	    (insert fmted-text (propertize "\n" 'hard t))
+	    (set-marker-insertion-type rcirc-prompt-start-marker nil)
+	    (set-marker-insertion-type rcirc-prompt-end-marker nil)
+
+	    ;; fill the text we just inserted, maybe
+	    (when (and rcirc-fill-flag
+		       (not (string= response "372"))) ;/motd
+	      (let ((fill-prefix
+		     (or rcirc-fill-prefix
+			 (make-string
+			  (or (next-single-property-change 0 'rcirc-text
+							   fmted-text)
+			      8)
+			  ?\s)))
+		    (fill-column (cond ((eq rcirc-fill-column 'frame-width)
+					(1- (frame-width)))
+				       (rcirc-fill-column
+					rcirc-fill-column)
+				       (t fill-column))))
+		(fill-region fill-start rcirc-prompt-start-marker 'left t))))
 
 	  ;; set inserted text to be read-only
 	  (when rcirc-read-only-flag



-- 
Quidquid latine dictum sit, altum viditur.