# HG changeset patch # User Miles Bader # Date 1139694143 0 # Node ID 7ba97c461db7ce757803241ad8c45aaf5a2b0cb5 # Parent 3e96b0954fa1e1c8a0443265654f104b282e7125 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-69 rcirc: Add flexible response formatting; Add nick abbrevs 2006-02-12 Miles Bader * lisp/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. diff -r 3e96b0954fa1 -r 7ba97c461db7 lisp/ChangeLog --- a/lisp/ChangeLog Sat Feb 11 21:30:22 2006 +0000 +++ b/lisp/ChangeLog Sat Feb 11 21:42:23 2006 +0000 @@ -1,3 +1,16 @@ +2006-02-12 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-11 Mathias Dahl * tumme.el: Enhanced some docstrings. Added todo item about diff -r 3e96b0954fa1 -r 7ba97c461db7 lisp/net/rcirc.el --- a/lisp/net/rcirc.el Sat Feb 11 21:30:22 2006 +0000 +++ b/lisp/net/rcirc.el Sat Feb 11 21:42:23 2006 +0000 @@ -195,6 +195,12 @@ :type '(repeat string) :group 'rcirc) +(defcustom rcirc-nick-abbrevs nil + "List of short replacements for printing nicks." + :type '(alist :key-type (string :tag "Nick") + :value-type (string :tag "Abbrev")) + :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. @@ -480,6 +486,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.") @@ -895,48 +906,112 @@ 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 (concat - sender - (when target (concat "," target))) - (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 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 (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)) (defun rcirc-target-buffer (process sender response target text) "Return a buffer to print the server response." @@ -988,38 +1063,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 nil text) - (propertize "\n" 'hard t)) - (set-marker-insertion-type rcirc-prompt-start-marker nil) - (set-marker-insertion-type rcirc-prompt-end-marker nil) + + (let ((fmted-text + (rcirc-format-response-string process sender response nil + 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 - (+ (if rcirc-time-format - (length (format-time-string - rcirc-time-format)) - 0) - (cond ((or (string= response "PRIVMSG") - (string= response "NOTICE")) - (+ (length sender) - 2)) ; <> - ((string= response "ACTION") - (+ (length 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))) + ;; 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