unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* rcirc changes
@ 2006-09-12 15:27 Richard Stallman
  2006-09-12 16:51 ` Chong Yidong
  0 siblings, 1 reply; 18+ messages in thread
From: Richard Stallman @ 2006-09-12 15:27 UTC (permalink / raw)


We're waiting for Ryan Yeske's changes about scrolling to
be installed in rcirc.el.  Would someone please install them?

^ permalink raw reply	[flat|nested] 18+ messages in thread
* rcirc changes
@ 2006-02-15  6:28 Ryan Yeske
  0 siblings, 0 replies; 18+ messages in thread
From: Ryan Yeske @ 2006-02-15  6:28 UTC (permalink / raw)



Some more misc bugfixes.


Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.9118
diff -c -r1.9118 ChangeLog
*** ChangeLog	12 Feb 2006 00:29:59 -0000	1.9118
--- ChangeLog	15 Feb 2006 06:20:04 -0000
***************
*** 1,3 ****
--- 1,22 ----
+ 2006-02-14  Ryan Yeske  <rcyeske@gmail.com>
+ 
+ 	* net/rcirc.el (rcirc-connect): Make all arguments optional, and
+ 	default to global variable values for unsupplied args.
+ 	(rcirc-get-buffer-create): Fix bug with setting the target.
+ 	(rcirc-any-buffer): Rename from rcirc-get-any-buffer, and include
+ 	test for rcirc-always-use-server-buffer-flag here.
+ 	(rcirc-response-formats): Add %N, which is a facified nick.  %n
+ 	uses the default face.  Change the ACTION format string.  If the
+ 	"nick" is the server, don't print anything for that field.
+ 	Comment fixes.
+ 	(rcirc-target-buffer): Don't test
+ 	rcirc-always-use-server-buffer-flag here.
+ 	(rcirc-print): Squeeze extra spaces out of the text before
+ 	message.
+ 	(rcirc-put-nick-channel): Strip potential "@" char from nick
+ 	before adding them to nick table.
+ 	(rcirc-url-regexp): Improve to match address like "foo.com".
+ 
  2006-02-12  Mathias Dahl  <mathias.dahl@gmail.com>
  
  	* tumme.el (tumme-write-tag): Fix small bug (file name did not
Index: net/rcirc.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/rcirc.el,v
retrieving revision 1.14
diff -c -r1.14 rcirc.el
*** net/rcirc.el	11 Feb 2006 21:42:23 -0000	1.14
--- net/rcirc.el	15 Feb 2006 06:20:07 -0000
***************
*** 49,55 ****
  (defgroup rcirc nil
    "Simple IRC client."
    :version "22.1"
!   :prefix "rcirc"
    :group 'applications)
  
  (defcustom rcirc-server "irc.freenode.net"
--- 49,55 ----
  (defgroup rcirc nil
    "Simple IRC client."
    :version "22.1"
!   :prefix "rcirc-"
    :group 'applications)
  
  (defcustom rcirc-server "irc.freenode.net"
***************
*** 295,310 ****
  (defvar rcirc-topic nil)
  (defvar rcirc-keepalive-timer nil)
  (defvar rcirc-last-server-message-time nil)
! (defun rcirc-connect (server port nick user-name full-name startup-channels)
    (add-hook 'window-configuration-change-hook
  	    'rcirc-window-configuration-change)
  
    (save-excursion
      (message "Connecting to %s..." server)
      (let* ((inhibit-eol-conversion)
!            (port-number (if (stringp port)
!                             (string-to-number port)
!                           port))
             (process (open-network-stream server nil server port-number)))
        ;; set up process
        (set-process-coding-system process 'raw-text 'raw-text)
--- 295,317 ----
  (defvar rcirc-topic nil)
  (defvar rcirc-keepalive-timer nil)
  (defvar rcirc-last-server-message-time nil)
! (defun rcirc-connect (&optional server port nick user-name full-name startup-channels)
    (add-hook 'window-configuration-change-hook
  	    'rcirc-window-configuration-change)
  
    (save-excursion
      (message "Connecting to %s..." server)
      (let* ((inhibit-eol-conversion)
!            (port-number (if port
! 			    (if (stringp port)
! 				(string-to-number port)
! 			      port)
! 			  rcirc-port))
! 	   (server (or server rcirc-server))
! 	   (nick (or nick rcirc-nick))
! 	   (user-name (or user-name rcirc-user-name))
! 	   (full-name (or full-name rcirc-user-full-name))
! 	   (startup-channels (or startup-channels (rcirc-startup-channels server)))
             (process (open-network-stream server nil server port-number)))
        ;; set up process
        (set-process-coding-system process 'raw-text 'raw-text)
***************
*** 758,766 ****
  Create the buffer if it doesn't exist."
    (let ((buffer (rcirc-get-buffer process target)))
      (if buffer
! 	(progn
  	  (when (not rcirc-target)
! 	    (setq rcirc-target target))
  	  buffer)
  	;; create the buffer
  	(with-rcirc-process-buffer process
--- 765,773 ----
  Create the buffer if it doesn't exist."
    (let ((buffer (rcirc-get-buffer process target)))
      (if buffer
! 	(with-current-buffer buffer
  	  (when (not rcirc-target)
!  	    (setq rcirc-target target))
  	  buffer)
  	;; create the buffer
  	(with-rcirc-process-buffer process
***************
*** 896,915 ****
    (kill-buffer (current-buffer))
    (set-window-configuration rcirc-window-configuration))
  
! (defun rcirc-get-any-buffer (process)
    "Return a buffer for PROCESS, either the one selected or the process buffer."
!   (let ((buffer (window-buffer (selected-window))))
!     (if (and buffer
! 	     (with-current-buffer buffer
! 	       (and (eq major-mode 'rcirc-mode)
! 		    (eq rcirc-process process))))
! 	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"))
--- 903,924 ----
    (kill-buffer (current-buffer))
    (set-window-configuration rcirc-window-configuration))
  
! (defun rcirc-any-buffer (process)
    "Return a buffer for PROCESS, either the one selected or the process buffer."
!   (if rcirc-always-use-server-buffer-flag
!       (process-buffer process)
!     (let ((buffer (window-buffer (selected-window))))
!       (if (and buffer
! 	       (with-current-buffer buffer
! 		 (and (eq major-mode 'rcirc-mode)
! 		      (eq rcirc-process process))))
! 	  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"))
***************
*** 921,927 ****
  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
--- 930,937 ----
  the of the following escape sequences replaced by the described values:
  
    %m        The message text
!   %n        The sender's nick
!   %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
***************
*** 957,1014 ****
  	(setq chunk (substring chunk 1)))
        (setq repl
  	    (cond ((eq key ?%)
! 		   ;; %% -- literal % character	;
  		   "%")
! 		  ((eq key ?n)
! 		   ;; %n -- nick	;
! 		   (rcirc-facify (concat (rcirc-abbrev-nick sender)
! 					 (and target (concat "," target)))
! 				 (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))
--- 967,1031 ----
  	(setq chunk (substring chunk 1)))
        (setq repl
  	    (cond ((eq key ?%)
! 		   ;; %% -- literal % character
  		   "%")
! 		  ((or (eq key ?n) (eq key ?N))
! 		   ;; %n/%N -- nick
! 		   (let ((nick (concat (if (string= (with-rcirc-process-buffer
! 							process rcirc-server)
! 						    sender)
! 					   ""
! 					 (rcirc-abbrev-nick sender))
! 				       (and target (concat "," target)))))
! 		     (rcirc-facify nick
! 				   (if (eq key ?n)
! 				       face
! 				     (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 -- server face
  			  (setq face 'rcirc-server))
  			 ((eq face-key ?-)
! 			  ;; %f- -- default 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))
***************
*** 1018,1026 ****
    (assert (not (bufferp target)))
    (with-rcirc-process-buffer process
      (cond ((not target)
! 	   (if rcirc-always-use-server-buffer-flag
! 	       (process-buffer process)
! 	     (rcirc-get-any-buffer process)))
  	  ((not (rcirc-channel-p target))
  	   ;; message from another user
  	   (if (string= response "PRIVMSG")
--- 1035,1041 ----
    (assert (not (bufferp target)))
    (with-rcirc-process-buffer process
      (cond ((not target)
! 	   (rcirc-any-buffer process))
  	  ((not (rcirc-channel-p target))
  	   ;; message from another user
  	   (if (string= response "PRIVMSG")
***************
*** 1029,1035 ****
  						  sender))
  	     (rcirc-get-buffer process target t)))
  	  ((or (rcirc-get-buffer process target)
! 	       (rcirc-get-any-buffer process))))))
  
  (defvar rcirc-activity-type nil)
  (make-variable-buffer-local 'rcirc-activity-type)
--- 1044,1050 ----
  						  sender))
  	     (rcirc-get-buffer process target t)))
  	  ((or (rcirc-get-buffer process target)
! 	       (rcirc-any-buffer process))))))
  
  (defvar rcirc-activity-type nil)
  (make-variable-buffer-local 'rcirc-activity-type)
***************
*** 1072,1093 ****
  	    (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
--- 1087,1112 ----
  	    (set-marker-insertion-type rcirc-prompt-start-marker nil)
  	    (set-marker-insertion-type rcirc-prompt-end-marker nil)
  
! 	    (let ((text-start (make-marker)))
! 	      (set-marker text-start
! 			  (or (next-single-property-change fill-start 
! 							   'rcirc-text)
! 			      (point-max)))
! 	      ;; squeeze spaces out of text before rcirc-text
! 	      (fill-region fill-start (1- text-start))
! 
! 	      ;; 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 (- text-start fill-start) ?\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
***************
*** 1178,1191 ****
  
  (defun rcirc-put-nick-channel (process nick channel)
    "Add CHANNEL to list associated with NICK."
!   (with-rcirc-process-buffer process
!     (let* ((chans (gethash nick rcirc-nick-table))
! 	   (record (assoc-string channel chans t)))
!       (if record
!           (setcdr record (current-time))
!         (puthash nick (cons (cons channel (current-time))
!                             chans)
!                  rcirc-nick-table)))))
  
  (defun rcirc-nick-remove (process nick)
    "Remove NICK from table."
--- 1197,1211 ----
  
  (defun rcirc-put-nick-channel (process nick channel)
    "Add CHANNEL to list associated with NICK."
!   (let ((nick (rcirc-user-nick nick)))
!     (with-rcirc-process-buffer process
!       (let* ((chans (gethash nick rcirc-nick-table))
! 	     (record (assoc-string channel chans t)))
! 	(if record
! 	    (setcdr record (current-time))
! 	  (puthash nick (cons (cons channel (current-time))
! 			      chans)
! 		   rcirc-nick-table))))))
  
  (defun rcirc-nick-remove (process nick)
    "Remove NICK from table."
***************
*** 1616,1630 ****
    (propertize (or string "") 'face face 'rear-nonsticky t))
  
  (defvar rcirc-url-regexp
!   (rx word-boundary
!       (or "www."
! 	  (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" "wais"
! 		   "mailto")
! 	       "://"
! 	       (1+ (char "a-zA-Z0-9_."))
! 	       (optional ":" (1+ (char "0-9")))))
!       (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]"))
!       (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]"))
    "Regexp matching URLs.  Set to nil to disable URL features in rcirc.")
  
  (defun rcirc-browse-url (&optional arg)
--- 1636,1656 ----
    (propertize (or string "") 'face face 'rear-nonsticky t))
  
  (defvar rcirc-url-regexp
!   (rx-to-string
!    `(and word-boundary
! 	 (or "www."
! 	     (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" 
! 		      "wais" "mailto")
! 		  "://"
! 		  (1+ (char "-a-zA-Z0-9_."))
! 		  (optional ":" (1+ (char "0-9"))))
! 	     (and (1+ (char "-a-zA-Z0-9_."))
! 		  (or ".com" ".net" ".org")
! 		  word-boundary))
! 	 (optional 
! 	  (and "/"
! 	       (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]"))
! 	       (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]")))))
    "Regexp matching URLs.  Set to nil to disable URL features in rcirc.")
  
  (defun rcirc-browse-url (&optional arg)

^ permalink raw reply	[flat|nested] 18+ messages in thread
* rcirc changes
@ 2006-02-09 12:07 Miles Bader
  2006-02-11 17:54 ` Ryan Yeske
  2006-02-15  5:58 ` Ryan Yeske
  0 siblings, 2 replies; 18+ messages in thread
From: Miles Bader @ 2006-02-09 12:07 UTC (permalink / raw)
  Cc: emacs-devel

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.

^ permalink raw reply	[flat|nested] 18+ messages in thread

end of thread, other threads:[~2006-09-12 22:08 UTC | newest]

Thread overview: 18+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2006-09-12 15:27 rcirc changes Richard Stallman
2006-09-12 16:51 ` Chong Yidong
2006-09-12 21:50   ` Ryan Yeske
2006-09-12 22:08     ` Chong Yidong
  -- strict thread matches above, loose matches on Subject: below --
2006-02-15  6:28 Ryan Yeske
2006-02-09 12:07 Miles Bader
2006-02-11 17:54 ` Ryan Yeske
2006-02-12  1:03   ` Miles Bader
2006-02-15  5:58 ` Ryan Yeske
2006-02-16  4:40   ` Richard M. Stallman
2006-02-16  5:07   ` Miles Bader
2006-02-16 16:30     ` Ryan Yeske
2006-02-16 20:56       ` Miles Bader
2006-02-17 12:56         ` Björn Lindström
2006-02-18  6:38           ` Miles Bader
2006-02-18 22:18             ` David Kastrup
2006-02-19  0:44               ` Miles Bader
2006-02-18 17:36         ` Alex Schroeder

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).