From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Miles Bader Newsgroups: gmane.emacs.devel Subject: rcirc changes Date: Thu, 09 Feb 2006 21:07:40 +0900 Message-ID: Reply-To: Miles Bader NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1139494782 9236 80.91.229.2 (9 Feb 2006 14:19:42 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Thu, 9 Feb 2006 14:19:42 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Feb 09 15:19:36 2006 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1F7Cde-0005gk-Vk for ged-emacs-devel@m.gmane.org; Thu, 09 Feb 2006 15:19:16 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1F7But-0003la-6w for ged-emacs-devel@m.gmane.org; Thu, 09 Feb 2006 08:32:59 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1F7AwR-0001m8-4P for emacs-devel@gnu.org; Thu, 09 Feb 2006 07:30:31 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1F7Aqo-00014n-GZ for emacs-devel@gnu.org; Thu, 09 Feb 2006 07:26:10 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1F7Aaa-0007Lb-RY for emacs-devel@gnu.org; Thu, 09 Feb 2006 07:07:57 -0500 Original-Received: from [203.180.232.83] (helo=mgate03.necel.com) by monty-python.gnu.org with esmtp (Exim 4.52) id 1F7Adz-0003cR-Oz; Thu, 09 Feb 2006 07:11:32 -0500 Original-Received: from relay21.aps.necel.com (relay21 [10.29.19.50]) by mgate03.necel.com (8.13.1/8.13.1) with ESMTP id k19ARfPN027450; Thu, 9 Feb 2006 21:07:42 +0900 (JST) Original-Received: from relay11.aps.necel.com ([10.29.19.20] [10.29.19.20]) by relay21.aps.necel.com with ESMTP; Thu, 9 Feb 2006 21:07:42 +0900 Original-Received: from dhapc248.dev.necel.com ([10.114.97.235] [10.114.97.235]) by relay11.aps.necel.com with ESMTP; Thu, 9 Feb 2006 21:07:42 +0900 Original-Received: by dhapc248.dev.necel.com (Postfix, from userid 31295) id E8D13571; Thu, 9 Feb 2006 21:07:41 +0900 (JST) Original-To: "Ryan Yeske" System-Type: i686-pc-linux-gnu Blat: Foop Original-Lines: 296 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:50241 Archived-At: 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 + + * 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 * 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.